{ FBA.PAS
(c) Daniel Lichtenberger }
{$N+}
uses WinTypes,WinProcs,OWindows,ODialogs,Objects,CommDlg,Strings,WinAPI,Win31,OMemory,HRead,BWCC,WinDos,FarbRed,BildMani,
TGA,PCX,ToolBar,Validate;
const cm_DateiOeffnen = 101;
cm_DateiSpeichern = 102;
cm_DateiSpeichernUnter = 103;
cm_FensterAnpassen = 201;
cm_BildAnpassen = 210;
cm_Zoom25 = 202;
cm_Zoom50 = 203;
cm_Zoom75 = 204;
cm_Zoom100 = 205;
cm_Zoom150 = 206;
cm_Zoom200 = 207;
cm_Zoom400 = 208;
cm_Zoom800 = 209;
cm_AttributeAnzeigen = 301;
cm_HistogrammAnzeigen = 303;
cm_Farbtiefe8bpp = 302;
cm_Farbtiefe24bpp = 304;
cm_Undo = 501;
cm_Helligkeit = 401;
cm_Vergroessern = 402;
cm_Mittelwert = 403;
cm_Laplace = 404;
cm_About = 601;
id_ScrollBar = 101; { THelligkeitDlg }
id_ProzText = 102;
id_Aufhellen = 103;
id_Verdunkeln = 104;
id_Text = 101; { TFortschrittDlg }
id_AttrText = 1001; { Attribut-Anzeigedlg }
id_BMPRadio = 101; { TFormatDlg }
id_TGARadio = 102;
id_PCXRadio = 103;
id_8bppRadio = 104;
id_16bppRadio = 105;
id_24bppRadio = 106;
id_UnkomprimiertRadio = 107;
id_RLERadio = 108;
id_InfoText = 109;
id_HelligkeitRadio = 101; { THistoDlg }
id_RotRadio = 102;
id_GruenRadio = 103;
id_BlauRadio = 104;
id_LogCheckBox = 108;
HistoX = 125; { Position und Ausmaße des Histogramms im Dialog }
HistoY = 20;
HistoW = 256;
HistoH = 147;
id_NewWInput = 102; { ResizeDlg }
id_NewHInput = 103;
err_Kein = 0;
err_Oeffnen = 1;
err_RAM = 2;
err_Komprimiert = 4;
err_PalBild = 8;
err_WenigFarben = 16;
err_Format = 32;
str_ProgName = 'FBA-Programm';
str_AlleDateien = 'Alle Bilddateien';
str_BMP = 'Windows BMP';
str_TGA = 'Targa (TGA)';
str_PCX = 'ZSoft PCX';
str_Fehler = 'Fehler';
str_KeinRAM = 'Fehler: Zuwenig Speicher frei.';
str_FehlerOeffnen = 'Fehler beim Öffnen der Datei.';
str_Hinweis = 'Hinweis';
str_Info = 'Information';
str_About = 'FBA-Programm (c) 1997,1998 Daniel Lichtenberger';
str_Gespeichert = ' wurde erfolgreich gespeichert.';
str_Komprimiert = 'ACHTUNG: Diese BMP-Datei ist komprimiert. Da dieses Programm komprimierte Dateien nicht '+
'unterstützt, können sie diese Datei zwar betrachten, aber nicht bearbeiten!';
str_PalBild = 'ACHTUNG: Diese Datei besitzt eine Farbtiefe von 8 Bits pro Pixel. Viele Effekte benötigen '+
'aber 24 Bit Farbtiefe. Konvertieren Sie dieses Bild nach Möglichkeit auf 24 Bit.';
str_WenigFarben = 'ACHTUNG: Diese Datei besitzt eine Farbtiefe von 4 Bits pro Pixel oder weniger. Da dieses '+
'Programm diese Dateien nicht unterstützt, können sie diese Datei zwar betrachten, '+
'aber nicht bearbeiten!';
str_Format = 'Fehler: Das Datenformat dieser Datei wird nicht unterstützt.';
str_MaxZoom = 'Fehler: Diese Auswahl würde die maximal zulässige Zoomstufe überschreiten.';
str_Grenze32 = 'Fehler: die Breite muß durch 4 teilbar sein - soll sie "aufgerundet" werden? ';
str_XYzuGross = 'Fehler: die neue Breite/Höhe darf nicht größer als 32000 sein.';
str_XYzuKlein = 'Fehler: die neue Breite/Höhe muß größer als 5 sein.';
str_BMPInfo = 'Wählt das BMP-Format. Keine Unterstützung von 16bpp und RLE.';
str_TGAInfo = 'Wählt das Targa-Format. 16bpp und RLE-Kompression möglich.';
str_PCXInfo = 'Wählt das ZSoft-PCX-Format. Keine Unterstützung von 16bpp.';
kein = 0;
t_BMP = 1;
t_PCX = 2;
t_TGA = 3;
type
PHistogramm = ^THistogramm; { Ein Helligkeits/Rot/Grün/Blau-Histogramm }
THistogramm = record
Helligkeit,Rot,Gruen,Blau: array[0..255] of longint;
MaxHelligkeit,MaxRot,MaxGruen,MaxBlau: longint;
end;
TApp = object(TApplication)
procedure InitMainWindow; virtual;
end;
PStatuszeile = ^TStatuszeile;
TStatuszeile = object(TWindow) { Eine Statuszeile }
Txt: PChar; { der dargestellte Text }
constructor Init(AParent: PWindowsObject);
procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
destructor Done; virtual;
procedure SetText(AText: PChar); { Txt auf AText setzen }
end;
PGraphWindow = ^TGraphWindow;
TGraphWindow = object(TWindow) { ein Fenster, in dem das Bild gezeichnet wird (inklusive Scrollbars) }
DIBInfo: PBitmapInfo; { Information über die DIB, in der alle Grafikdaten gespeichert sind }
TGAInfo: TTGAInfo; { Information über eine geladene TGA-Datei }
PCXInfo: TPCXInfo; { Information über eine geladene PCX-Datei }
BMPHeader: TBitmapFileHeader; { wird nur bei geladener BMP-Datei "gefüllt" }
DIBInfoSize: word; { Größe von DIBInfo in Bytes }
FSize: longint; { Dateigröße }
FType: byte; { entweder kein, t_BMP, t_PCX oder t_TGA }
DIBData: pointer; { Zeiger auf die Grafikdaten }
DataSize: longint; { Größe der Grafikdaten }
ZoomX,ZoomY: real; { Zoomfaktor X/Y-Achse }
StretchBMP: bool; { soll das Bild auf Fenstergröße vergrößert/verkleinert werden? }
ZoomRect: TRect; { zum Zoomen eines bestimmten Bereichs durch die linke Maustaste }
ZoomRectDC: HDC; { DC für das Rechteck }
UndoDateiName: array[0..255] of char; { Dateiname der Undo-Datei }
UndoValid: bool; { ist die Undo-Datei "gültig", d.h. aktuell? }
constructor Init(AParent: PWindowsObject);
procedure SetupWindow; virtual;
destructor Done; virtual;
{ Die folgenden drei Prozeduren sind für das Zoom-Rechteck zuständig }
procedure WMLButtonDown(var Msg: TMessage); virtual wm_First+wm_LButtonDown; { Linker Mausbutton "unten" }
procedure WMLButtonUp(var Msg: TMessage); virtual wm_First+wm_LButtonUp; { Linker Mausbutton losgelassen }
procedure WMMouseMove(var Msg: TMessage); virtual wm_First+wm_MouseMove; { Maus wurde bewegt }
procedure WMSize(var Msg: TMessage); virtual wm_First+wm_Size; { Anpassen der Scrollbars von ZoomX/ZoomY,
wenn StretchBMP true ist }
procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
function _LoadBMP(FName: PChar):integer; { lädt BMP-Datei - nur für internen Gebrauch! }
function LoadBMP(FName: PChar):integer; { lädt BMP-Datei }
function LoadTGA(FName: PChar):integer; { lädt TGA-Datei }
function LoadPCX(FName: PChar):integer; { lädt PCX-Datei }
procedure SaveBMP(FName: PChar); { schreibt BMP-Datei }
procedure SaveTGA(FName: PChar); { schreibt TGA-Datei }
procedure SavePCX(FName: PChar); { schreibt PCX-Datei }
procedure Konv8zu24; { Konvertiert ein 8-Bit-Bild in ein 24-Bit-Bild }
procedure Konv24zu8; { Konvertiert ein 24-Bit-Bild in ein 8-Bit-Bild }
procedure ResizeBmp(NewW,NewH: integer); { verändert die Größe des Bilds }
procedure AdjustScrollers; { stellt die Bildlaufleisten (Scroller) neu ein }
procedure StretchBitmap; { berechnet ZoomX/ZoomY, damit das Bild auf Fenstergröße gestreckt wird }
procedure SaveUndoFile; { speichert Undo-Datei }
end;
PMainWindow = ^TMainWindow;
TMainWindow = object(TWindow) { das Programmfenster }
GraphWnd: PGraphWindow; { zur Anzeige des Bildes }
Statuszeile: PStatuszeile; { Statuszeile, für die Ausgabe von Informationen }
ToolBar: PToolBar; { Toolbar, stellt die Icons am oberen Fensterrand dar }
WndMaximized: boolean; { true, wenn das Programm den ganzen Bildschirm belegt }
DateiName: array[0..255] of char; { Name der gerade geladenen Datei }
Changed: bool; { true, wenn Datei geändert wurde (durch das Programm) }
constructor Init(AParent: PWindowsObject; ATitle: PChar);
procedure GetWindowClass(var WndClass: TWndClass); virtual; { zur Darstellung des grauen Hintergrunds }
procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct); virtual;
procedure WMSize(var Msg: TMessage); virtual wm_First+wm_Size;
{ Die folgenden Prozeduren werden ausgeführt, wenn der entsprechende Menüpunkt ausgewählt wurde }
procedure cmDateiOeffnen(var Msg: TMessage); virtual cm_First+cm_DateiOeffnen;
procedure cmDateiSpeichern(var Msg: TMessage); virtual cm_First+cm_DateiSpeichern;
procedure cmDateiSpeichernUnter(var Msg: TMessage); virtual cm_First+cm_DateiSpeichernUnter;
procedure cmFensterAnpassen(var Msg: TMessage); virtual cm_First+cm_FensterAnpassen;
{ das Fenster der Bildgröße anpassen }
procedure cmBildAnpassen(var Msg: TMessage); virtual cm_First+cm_BildAnpassen;
{ das Bild der Fenstergröße anpassen }
procedure cmAttributeAnzeigen(var Msg: TMessage); virtual cm_First+cm_AttributeAnzeigen;
{ wichtige Dateiattribute in einem Dialog anzeigen }
procedure cmHistogrammAnzeigen(var Msg: TMessage); virtual cm_First+cm_HistogrammAnzeigen;
{ Histogramm in einem Dialog anzeigen }
procedure cmFarbtiefe8bpp(var Msg: TMessage); virtual cm_First+cm_Farbtiefe8bpp;
{ Farbtiefe auf 8bpp setzen }
procedure cmFarbtiefe24bpp(var Msg: TMessage); virtual cm_First+cm_Farbtiefe24bpp;
{ Farbtiefe auf 24bpp setzen }
{ Zoomstufen dem Menüeintrag entsprechend setzen }
procedure cmZoom25(var Msg: TMessage); virtual cm_First+cm_Zoom25;
procedure cmZoom50(var Msg: TMessage); virtual cm_First+cm_Zoom50;
procedure cmZoom75(var Msg: TMessage); virtual cm_First+cm_Zoom75;
procedure cmZoom100(var Msg: TMessage); virtual cm_First+cm_Zoom100;
procedure cmZoom150(var Msg: TMessage); virtual cm_First+cm_Zoom150;
procedure cmZoom200(var Msg: TMessage); virtual cm_First+cm_Zoom200;
procedure cmZoom400(var Msg: TMessage); virtual cm_First+cm_Zoom400;
procedure cmZoom800(var Msg: TMessage); virtual cm_First+cm_Zoom800;
procedure cmUndo(var Msg: TMessage); virtual cm_First+cm_Undo; { Undo-Datei laden }
procedure cmHelligkeit(var Msg: TMessage); virtual cm_First+cm_Helligkeit; { Aufhellen/Abdunkeln }
procedure cmResize(var Msg: TMessage); virtual cm_First+cm_Vergroessern; { Vergrössern/Verkleinern }
procedure cmMittelwert(var Msg: TMessage); virtual cm_First+cm_Mittelwert;
procedure cmLaplace(var Msg: TMessage); virtual cm_First+cm_Laplace;
procedure cmAbout(var Msg: TMessage); virtual cm_First+cm_About;
procedure WendeMaskeAn(Maske: TMaske; txt: PChar); { wird von cmMittelwert und cmLaplace verwendet }
procedure EnableItem(cm: word; Enabled: word); { Stellt einen Menüpunkt bzw. Toolbar-Icon grau dar,
wenn Enabled = mf_Grayed, wenn Enabled = mf_Enabled wird der Menüpunkt/Icon
normal dargestellt und kann ausgewählt werden }
procedure Akt_Menus; { Aktualisiert alle Menüpunkte, d.h. (de-)aktiviert sie je nach Dateityp usw. }
procedure ZoomEnable; { alle Zoom-Menüpunkte/Icons können ausgewählt werden }
procedure ZoomDisable; { kein Zoom-Menüpunkt/Icon kann ausgewählt werden }
procedure SetZoomCheck(cm: word); { setzt die Markierung im Zoom-Menü zum angegebenen Eintrag }
procedure ResizeWnd(NewW,NewH: longint); { versucht, das Hauptfenster den erwünschten Ausmaßen
anzupassen }
procedure SetzeStatusZeile; { Gibt in der Statuszeile Informationen über das Bild aus }
procedure GetUndo; { Lädt Undo-Datei }
end;
PHelligkeitDlg = ^THelligkeitDlg;
THelligkeitDlg = object(TDialog)
ScrollBar: PScrollBar; { zum Einstellen des Aufhellungs/Abdunkelungsfaktors }
ProzText: PStatic; { zeigt den "Wert" der ScrollBars an }
ButtonHeller,ButtonDunkler: PButton; { die Buttons zum Aufhellen/Abdunkeln }
constructor Init(AParent: PWindowsObject);
procedure SetupWindow; virtual;
procedure HandleScrollBar(var Msg: TMessage); virtual id_First+id_ScrollBar; { wenn Scrollbar
verschoben wurde }
procedure Aufhellen(var Msg: TMessage); virtual id_First+id_Aufhellen;
{ wenn der Aufhellen-Button gedrückt wurde }
procedure Verdunkeln(var Msg: TMessage); virtual id_First+id_Verdunkeln;
{ wenn der Abdunkeln-Button gedrückt wurde }
end;
PFortschrittDlg = ^TFortschrittDlg; { Dialog, der im Hintergrund dargestellt wird und den Benutzer über den }
TFortschrittDlg = object(TDialog) { Fortschritt einer Aktion in Kenntnis setzt (z.B. "Lade Datei") }
Txt: PStatic;
constructor Init(AParent: PWindowsObject);
procedure SetupWindow; virtual;
procedure SetText(NeuerText: PChar);
end;
PFormatDlg = ^TFormatDlg; { Dialog zum Auswählen des Dateiformats (bei Datei Speichern Unter) }
TFormatDlg = object(TDialog)
BMPRadio, TGARadio, PCXRadio, { Radiobuttons, die die versch. Optionen repräsentieren }
_8bppRadio, _16bppRadio, _24bppRadio,
UnkomprimiertRadio, RLERadio: PRadioButton;
InfoText: PStatic;
constructor Init(AParent: PWindowsObject);
procedure SetupWindow; virtual;
{ die folgenden Prozeduren werden aufgerufen, wenn der entsprechende Radiobutton ausgewählt wurde }
procedure BMPRadioSelected(var Msg: TMessage); virtual id_First+id_BMPRadio;
procedure TGARadioSelected(var Msg: TMessage); virtual id_First+id_TGARadio;
procedure PCXRadioSelected(var Msg: TMessage); virtual id_First+id_PCXRadio;
procedure _16bppRadioSelected(var Msg: TMessage); virtual id_First+id_16bppRadio;
procedure UnkomprimiertRadioSelected(var Msg: TMessage); virtual id_First+id_UnkomprimiertRadio;
procedure RLERadioSelected(var Msg: TMessage); virtual id_First+id_RLERadio;
end;
PHistoDlg = ^THistoDlg; { Dialog zur Anzeige von Histogrammen }
THistoDlg = object(TDialog)
Histogramm: PHistogramm; { das darzustellende Histogramm }
HelligkeitRadio,RotRadio,GruenRadio,BlauRadio: PRadioButton;
LogCheckbox: PCheckBox; { Checkbox, um logarithmische Darstellung zu aktivieren }
MassY: real; { Maßstab für y-Achse }
constructor Init(AParent: PWindowsObject; Histo: PHistogramm);
procedure SetupWindow; virtual;
procedure ZeichneHistogramm; { Zeichnet das Histogramm, das durch den entsprechenden
Radiobutton ausgewählt wurde (Helligkeit, Rot, Grün,
Blau) }
{ die folgenden Prozeduren werden aufgerufen, wenn der entsprechende Radiobutton/Checkbox
ausgewählt wurde }
procedure HelligkeitRadioSelected(var Msg: TMessage); virtual id_First+id_HelligkeitRadio;
procedure RotRadioSelected(var Msg: TMessage); virtual id_First+id_RotRadio;
procedure GruenRadioSelected(var Msg: TMessage); virtual id_First+id_GruenRadio;
procedure BlauRadioSelected(var Msg: TMessage); virtual id_First+id_BlauRadio;
procedure LogCheckboxSelected(var Msg: TMessage); virtual id_First+id_LogCheckbox;
end;
var ScrWidth,ScrHeight: integer; { Max. Größe für ein Fenster }
{$R FBA.RES} { Resourcendatei einbinden (Dialoge, Hauptmenü, Icons, Toolbar) }
{ Assembler-Prozeduren für die Bearbeitung des DIBs }
function GetPixel8(PixelOffset: longint; var DIBData):byte; external;
procedure SetPixel8(PixelOffset: longint; var DIBData; color: byte); external;
procedure GetPixel24(PixelOffset: longint; var DIBData; var RGBQuad: TRGBQuad); external;
procedure SetPixel24(PixelOffset: longint; var DIBData; var RGBQuad: TRGBQuad); external;
procedure Konv8bppTo24bpp(OldDIB: pointer; OldSize: longint; NewDIB,Pal: pointer); external; { konvertiert ein 8-Bit-Bild
in ein 24-Bit-Bild }
{$L FBA.OBJ} { OBJ-Datei für FBA.ASM }
procedure TApp.InitMainWindow;
begin
MainWindow := New(PMainWindow,Init(nil,str_ProgName));
end;
constructor TStatuszeile.Init(AParent: PWindowsObject);
begin
inherited Init(AParent,nil);
Attr.Style := ws_Child or ws_Visible;
Attr.X := 0;
Attr.Y := 0;
Attr.W := 100;
Attr.H := 20;
Txt := nil;
end;
procedure TStatuszeile.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
var Font: HFont;
r: TRect;
begin
inherited Paint(PaintDC,PaintInfo);
GetClientRect(HWindow,r);
SelectObject(PaintDC,GetStockObject(LtGray_Brush)); { richtige Farbe für Schrift und Hintergrund auswählen }
SelectObject(PaintDC,GetStockObject(Black_Pen));
Rectangle(PaintDC,0,0,r.right-1,r.bottom-1);
SetTextColor(PaintDC,RGB(0,0,0));
SetBkMode(PaintDC,Transparent); { damit die Schrift den grauen Hintergrund nicht überdeckt }
Font := CreateFont(15,5,0,0,FW_THIN,
0,0,0,ANSI_Charset,Out_TT_Precis,Clip_Default_Precis,Default_Quality,Default_Pitch,
'Arial'); { einen passenden Font (Schriftart) auswählen }
SelectObject(PaintDC,Font);
TextOut(PaintDC,2,2,txt,StrLen(txt));
DeleteObject(Font);
end;
destructor TStatuszeile.Done;
begin
inherited Done;
StrDispose(txt);
end;
procedure TStatuszeile.SetText(AText:PChar);
begin
StrDispose(txt);
txt := StrNew(AText);
end;
constructor TGraphWindow.Init(AParent: PWindowsObject);
var p: PChar;
begin
inherited Init(AParent,'');
attr.Style := attr.Style or ws_Child or ws_HScroll or ws_VScroll;
attr.x := 0;
attr.y := 31; { Damit fügt sich das Graph-Window direkt unter der Toolbar ein }
attr.w := 300;
attr.h := 300;
DIBData := nil;
DataSize := 0;
Scroller := New(PScroller, Init(@self,1,1,0,0)); { Beim Programmstart sind die Scrollbars unsichtbar }
Scroller^.AutoMode := false; { Der Autoscroll-Modus erschwert die korrekte Darstellung
des Zoom-Rechtecks }
DIBInfo := MemAlloc(SizeOf(TBitmapInfoHeader)); { das DIB initialisieren }
DIBInfoSize := SizeOf(TBitmapInfoHeader);
DIBInfo^.bmiHeader.biWidth := 0;
DIBInfo^.bmiHeader.biHeight := 0;
FType := kein;
ZoomX := 1; { kein Zoom }
ZoomY := 1;
FillChar(ZoomRect,SizeOf(ZoomRect),0);
ZoomRect.left := -1;
StretchBMP := false; { Bild wird nicht auf Fensterausmaße gestreckt }
FillChar(UndoDateiname,SizeOf(UndoDateiname),0); { Namen der Undo-Datei ermitteln (wird im TEMP-Verzeichnis
angelegt }
GetMem(p,256);
FillChar(p^,256,0);
p := GetEnvVar('TEMP');
StrCopy(UndoDateiname,p);
StrCat(UndoDateiname,'\fbaundo.tmp');
UndoValid := false;
end;
procedure TGraphWindow.SetupWindow;
begin
inherited SetupWindow;
ZoomRectDC := GetDC(HWindow);
SetROP2(ZoomRectDC,r2_XORPen); { Das Zoomrechteck wird mit XOR-Operationen dargestellt: daher kann es gelöscht
werden, wenn es ein zweites Mal an dieselbe Stelle gezeichnet wird }
SelectObject(ZoomRectDC,GetStockObject(White_Pen));
SelectObject(ZoomRectDC,GetStockObject(Null_Brush));
end;
destructor TGraphWindow.Done;
var f: file;
begin
inherited Done;
ReleaseDC(HWindow,ZoomRectDC);
GlobalFreePtr(DIBData); { Speicher freigeben }
FreeMem(DIBInfo,DIBInfoSize);
Assign(f,UndoDateiname); { Undo-Datei löschen }
{$I-}
Erase(f);
{$I+}
end;
procedure TGraphWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
begin
inherited Paint(PaintDC,PaintInfo);
if DIBData = nil then exit;
SetStretchBltMode(PaintDC,Stretch_DeleteScans); { für ZoomX/Y kleiner als 1 - sonst kann es zu merkwürdigen
Ergebnissen kommen }
with DIBInfo^.bmiHeader do begin
if StretchBMP then StretchBitmap; { Bitmap an die Fenstergröße anpassen, falls gewünscht }
StretchDIBits(PaintDC,0,0,Round(ZoomX*biWidth),Round(ZoomY*biHeight),0,0,biWidth,biHeight,DIBData,
DIBInfo^,DIB_RGB_Colors,SrcCopy) { DIB ausgeben }
end;
end;
procedure TGraphWindow.WMSize(var Msg: TMessage);
begin
inherited WMSize(Msg);
Scroller^.AutoOrg := true; { Bitmap eventuell auf Fensterausmaße dehnen und Scroller anpassen }
if StretchBMP then StretchBitmap;
AdjustScrollers;
end;
procedure TGraphWindow.AdjustScrollers;
var r: TRect;
begin
if FType = Kein then
Scroller^.SetRange(0,0)
else begin
GetClientRect(HWindow,r); { Ausmaße des eigentlichen Zeichenfensters (ohne Menüleiste) bestimmen }
with r do
with DIBInfo^.bmiHeader do { Scroller setzen }
Scroller^.SetRange(Round(ZoomX*biWidth)-(right-left),Round(ZoomY*biHeight)-(bottom-top));
end;
end;
procedure TGraphWindow.StretchBitmap;
var r: TRect;
begin
GetClientRect(HWindow,r);
with r do
with DIBInfo^.bmiHeader do
if (biWidth > 0) and (biHeight > 0) then begin
ZoomX := (right-left)/biWidth; { die notwendigen Zoomfaktoren ermitteln, um das Bild auf Fensterausmaße zu dehnen }
ZoomY := (bottom-top)/biHeight;
end;
end;
{ Das Laden eines Bitmaps gestaltet sich sehr einfach, da eine BMP-Datei praktisch eine Festplattenkopie eines DIBs ist }
function TGraphWindow._LoadBMP(FName: PChar):integer;
var HFile: THandle;
f: file;
FileBuf: TOfStruct;
BMPInfoHeader: TBitmapInfoHeader;
BytesRemaining: longint;
PalSize: longint;
Return: integer;
begin
Return := 0; { noch kein Fehler... }
FillChar(FileBuf,SizeOf(FileBuf),0);
HFile := OpenFile(FName,FileBuf,of_Read); { Datei öffnen }
if HFile = -1 then begin { Datei kann nicht geöffnet werden... }
_LoadBMP := err_Oeffnen;
exit;
end;
FillChar(BMPHeader,SizeOf(BMPHeader),0);
_hread(HFile,@BMPHeader,SizeOf(BMPHeader)); { Dateiheader laden }
if BMPHeader.bfType <> $4D42 then begin { wenn die Kennung nicht "BM" ist, abbrechen }
_LoadBMP := err_Format;
_lclose(HFile);
exit;
end;
FSize := BMPHeader.bfSize;
_hread(HFile,@BMPInfoHeader,SizeOf(TBitmapInfoHeader)); { BitmapInfoHeader lesen }
if BMPInfoHeader.biBitCount <= 8 then begin
{ nur bei Farbtiefen <= 8bpp gibt's eine Palette }
PalSize := (1 shl BMPInfoHeader.biBitCount)*SizeOf(TRGBQuad); { Größe der Palette bestimmen }
BMPInfoHeader.biClrUsed := 1 shl BMPInfoHeader.biBitCount;{ Anzahl der verwendeten Farben setzen,
sonst gibt's z.B. beim Speichern als 8bpp-TGA-Datei Probleme... }
end
else PalSize := 0;
FreeMem(DIBInfo,DIBInfoSize); { alte DIB-Informationen löschen und Speicherplatz freigeben }
DIBInfoSize := SizeOf(TBitmapInfoHeader)+PalSize; { die Größe der neuen DIBInfo bestimmen (Palette miteingerechnet) }
DIBInfo := MemAlloc(DIBInfoSize);
Move(BMPInfoHeader,DIBInfo^.bmiHeader,SizeOf(TBitmapInfoHeader));
if DIBInfo^.bmiHeader.biCompression <> bi_RGB then Inc(Return,err_Komprimiert); { ev. Probleme dem Programm mitteilen }
if DIBInfo^.bmiHeader.biBitCount = 8 then Inc(Return,err_PalBild);
if DIBInfo^.bmiHeader.biBitCount <= 4 then Inc(Return,err_WenigFarben);
_hread(HFile,@DIBInfo^.bmiColors,PalSize); { Palette laden }
BytesRemaining := BMPHeader.bfSize-BMPHeader.bfOffBits; { Größe der Bilddaten bestimmen }
if DataSize <> 0 then GlobalFreePtr(DIBData); { Speicher freigeben }
DataSize := BytesRemaining;
DIBData := GlobalAllocPtr(GHND,DataSize);
if DIBData = nil then begin
_LoadBMP := err_RAM; { Fehler, wenn zuwenig Arbeitsspeicher frei ist }
DataSize := 0;
exit;
end;
_llseek(HFile,BMPHeader.bfOffBits,0);
_hread(HFile,DIBData,DataSize); { Bilddaten lesen }
_lclose(HFile);
_LoadBMP := Return;
end;
function TGraphWindow.LoadBMP(FName: PChar): integer;
begin
LoadBMP := _LoadBMP(FName);
FType := t_BMP;
end;
function TGraphWindow.LoadTGA(FName: PChar): integer;
begin
LoadTGA := _LoadTGA(FName,TGAInfo,DIBData,DataSize,DIBInfo,DIBInfoSize);
BMPHeader.bfType := $4D42; { ID-Bytes auf "BM" setzen}
BMPHeader.bfSize := TGAInfo.FSize;
BMPHeader.bfOffBits := SizeOf(TBitmapFileHeader)+DIBInfoSize;
FSize := TGAInfo.FSize;
FType := t_TGA;
end;
function TGraphWindow.LoadPCX(FName: PChar): integer;
begin
LoadPCX := _LoadPCX(FName,PCXInfo,DIBData,DataSize,DIBInfo,DIBInfoSize);
BMPHeader.bfType := $4D42; { "BM" }
BMPHeader.bfSize := PCXInfo.FSize;
BMPHeader.bfOffBits := SizeOf(TBitmapFileHeader)+DIBInfoSize;
FSize := PCXInfo.FSize;
FType := t_PCX;
end;
procedure TGraphWindow.SaveBMP(FName: PChar);
var HFile: THandle;
FileBuf: TOfStruct;
begin
HFile := OpenFile(FName,FileBuf,of_Create or of_Write); { Datei neu erstellen }
if HFile = -1 then begin
MessageBox(HWindow,str_FehlerOeffnen,str_Fehler,mb_IconExclamation or mb_OK);
exit;
end;
BMPHeader.bfType := $4D42; { auf "BM" setzen }
BMPHeader.bfOffbits := SizeOf(TBitmapFileHeader)+DIBInfoSize;
BMPHeader.bfSize := SizeOf(TBitmapFileHeader)+DIBInfoSize+DataSize;
_hwrite(HFile,@BMPHeader,SizeOf(BMPHeader)); { Dateiheader schreiben }
_hwrite(HFile,DIBInfo,DIBInfoSize); { DIBInfo schreiben }
_hwrite(HFile,DIBData,DataSize); { Bilddaten schreiben }
_lclose(HFile);
end;
procedure TGraphWindow.SaveTGA(FName: PChar);
begin
_SaveTGA(FName,TGAInfo,DIBData,DataSize,DIBInfo); { Prozedur aus TGA.PAS }
end;
procedure TGraphWindow.SavePCX(FName: PChar);
begin
_SavePCX(FName,PCXInfo,DIBData,DataSize,DIBInfo); { Prozedur aus PCX.PAS }
end;
procedure TGraphWindow.WMLButtonDown(var Msg: TMessage);
var pt: TPoint;
r: TRect;
begin
inherited WMLButtonDown(Msg);
GetClientRect(HWindow,r);
pt.x := Msg.lParamLo; { Koordinaten des Mausklicks ermitteln }
pt.y := Msg.lParamHi;
if (pt.x < 0) or (pt.y < 0) then exit;
with ZoomRect do begin
left := pt.x;
top := pt.y;
right := left;
bottom := top;
end;
SetCapture(HWindow); { Damit das Rechteck nicht "stehenbleibt", wenn der Mauszeiger das Fenster (bzw. die Client-
Area) verläßt }
end;
procedure TGraphWindow.WMLButtonUp(var Msg: TMessage);
var sx,sy: integer;
r: TRect;
OldZoomX: real;
procedure xchgint(var i1,i2:integer); { vertauscht zwei integer }
var tmp:integer;
begin
tmp := i1; i1 := i2; i2 := tmp;
end;
begin
ReleaseCapture;
if DIBData = nil then exit;
GetClientRect(HWindow,r);
with ZoomRect do begin
Rectangle(ZoomRectDC,left,top,right,bottom);
if right < left then xchgint(left,right); { rechts/links und oben/unten richtigstellen }
if bottom < top then xchgint(top,bottom);
if (right-left < 3) or (bottom-top < 3) then exit; { Derart hohe Zoomstufen arbeiten oft nicht richtig
(und bringen auch nicht viel) }
sx := Round((left + Scroller^.XPos) / ZoomX); { Position der linken oberen Ecke im "echten" DIB feststellen }
sy := Round((top + Scroller^.YPos) / ZoomY); { (unter Berücksichtigung von Scrollbar-Position und Zoomstufe }
OldZoomX := ZoomX;
ZoomX := (r.right-r.left)/((right-left)/ZoomX);
if (Round(ZoomX*DIBInfo^.bmiHeader.biWidth) > 32767) or { Windows kann max. integer-große Bilder darstellen }
(Round(ZoomY*DIBInfo^.bmiHeader.biHeight) > 32767) then begin
MessageBox(HWindow,str_MaxZoom,str_Fehler,mb_IconExclamation or mb_OK);
ZoomX := OldZoomX; { wieder alte Zoomstufe setzen }
exit;
end;
ZoomY := ZoomX;
sx := Round(sx*ZoomX);
sy := Round(sy*ZoomY);
AdjustScrollers; { da Position und Zoomstufe verändert wurden }
Scroller^.ScrollTo(sx,sy); { zur richtigen Position scrollen }
InvalidateRect(Parent^.HWindow,nil,false); { Gleich das ganze Programmfenster neu zeichnen, damit z.B. auch die
Titelzeile angepaßt wird }
left := -1;
end;
end;
procedure TGraphWindow.WMMouseMove(var Msg: TMessage);
var r: TRect;
AspectRatio: real;
begin
if (Msg.wParam and mk_LButton = 0) or (DIBData = nil) or (GetCapture <> HWindow) then exit;
{ wenn nicht gerade das Zoomrechteck gezeichnet wird, wieder aussteigen }
GetClientRect(HWindow,r);
with r do
AspectRatio := (right-left)/(bottom-top); { Verhältnis Breite:Höhe des Fensters - wichtig, da das gezoomte Bild
ja exakt dem Rechtecksinhalt entsprechen sollte }
if ZoomRect.left <> -1 then with ZoomRect do
Rectangle(ZoomRectDC,left,top,right,bottom); { altes Zoomrechteck zeichnen - da XOR-Maske, wird es gelöscht }
with ZoomRect do begin
right := Msg.lParamLo;
if right < 0 then right := 0;
if integer(Msg.lParamHi) > top then
bottom := top+Round(Abs(right-left)/AspectRatio)
else bottom := top-Round(Abs(right-left)/AspectRatio);
Rectangle(ZoomRectDC,left,top,right,bottom); { neues Zoomrechteck zeichnen }
end;
end;
procedure TGraphWindow.Konv8zu24;
var NewData: pointer;
NewSize: longint;
RGBQuad: array[0..255] of TRGBQuad;
bmiTmp: TBitmapInfoHeader;
begin
with DIBInfo^.bmiHeader do begin
NewSize := DataSize*3; { die neuen Bilddaten haben natürlich den dreifachen Platzbedarf }
NewData := GlobalAllocPtr(GHND,NewSize);
if NewData = nil then begin
MessageBox(HWindow,str_KeinRAM,str_Fehler,mb_IconExclamation or mb_OK);
exit;
end;
Konv8bppTo24bpp(DIBData,DataSize,NewData,@DIBInfo^.bmiColors); { konvertieren... }
GlobalFreePtr(DIBData); { alte Bilddaten löschen, Zeiger auf neue Bilddaten setzen }
DIBData := NewData;
DataSize := NewSize;
Move(DIBInfo^.bmiHeader,bmiTmp,SizeOf(TBitmapInfoHeader)); { neue DIBInfo schaffen, alte löschen (wegen der Palette) }
FreeMem(DIBInfo,DIBInfoSize);
DIBInfoSize := SizeOf(TBitmapInfoHeader);
DIBInfo := MemAlloc(DIBInfoSize);
Move(bmiTmp,DIBInfo^.bmiHeader,SizeOf(TBitmapInfoHeader));
DIBInfo^.bmiHeader.biBitCount := 24;
BMPHeader.bfOffBits := SizeOf(TBitmapFileHeader)+DIBInfoSize;
FSize := SizeOf(TBitmapFileHeader) + DIBInfoSize + DataSize; { neue Dateigröße berechnen }
end;
end;
procedure TGraphWindow.Konv24zu8;
type TVolHist = array[0..32768] of byte; { ein Volumenhistogramm }
var Pal: array[0..255] of TRGBQuad;
bmiTmp: TBitmapInfoHeader;
NewData: pointer;
NewSize: longint;
OldCursor: HCursor;
VolHist: ^TVolHist;
Dlg: PFortschrittDlg;
begin
OldCursor := SetCursor(LoadCursor(0,idc_Wait));
with DIBInfo^.bmiHeader do begin
Dlg := New(PFortschrittDlg,Init(@self)); { zur Ausgabe von Informationen }
NewSize := longint(biWidth)*biHeight; { die neuen Bilddaten haben nur ein Drittel vom vorherigen Platzbedarf }
NewData := GlobalAllocPtr(GHND,NewSize);
if NewData = nil then begin
MessageBox(HWindow,str_KeinRAM,str_Fehler,mb_IconExclamation or mb_OK);
exit;
end;
Dlg^.Create; { Dialog erschaffen, der den Benutzer über den Fortschritt der Berechnungen informiert }
Dlg^.SetText('Versuche, Palette direkt zu berechnen...');
if not ErstelleIdentPal24(DIBData^,DIBInfo,NewData^,Pal) then begin
{ Adaptive Farbpalette erstellen, wenn die Palette nicht direkt errechnet werden konnte }
GetMem(VolHist,32769);
with DIBInfo^.bmiHeader do begin
Dlg^.SetText('Bereite Erstellung einer adaptiven Farbpalette vor...');
ErstelleVolumenHist(DIBData^,DIBInfo,VolHist^); { Volumenhistogramm erstellen }
Dlg^.SetText('Erstelle adaptive Farbpalette...');
ErstelleAdaptivePal(DIBData^,DIBInfo,VolHist^,NewData^,Pal,256,0);
{ adaptive Farbpalette erstellen }
end;
Dispose(VolHist);
end;
GlobalFreePtr(DIBData); { den Speicher der alten 24bpp-Bilddaten freigeben }
DIBData := NewData; { Zeiger auf die neuen Bilddaten setzen }
DataSize := NewSize;
{ die betreffenden Einträge in DIBInfo richtig setzen }
Move(DIBInfo^.bmiHeader,bmiTmp,SizeOf(TBitmapInfoHeader)); { bmiHeader vom alten DIBInfo speichern }
FreeMem(DIBInfo,DIBInfoSize); { Speicherplatz freigeben }
DIBInfoSize := SizeOf(TBitmapInfoHeader)+256*SizeOf(TRGBQuad); { Palette muß miteingerechnet werden }
DIBInfo := MemAlloc(DIBInfoSize);
Move(bmiTmp,DIBInfo^.bmiHeader,SizeOf(TBitmapInfoHeader));{ bmiHeader vom alten DIBInfo übernehmen }
Move(Pal,DIBInfo^.bmiColors,256*SizeOf(TRGBQuad));
DIBInfo^.bmiHeader.biBitCount := 8; { Einträge für ein 8bpp-Bild setzen }
DIBInfo^.bmiHeader.biClrUsed := 256;
DIBInfo^.bmiHeader.biClrImportant := 0;
BMPHeader.bfOffBits := SizeOf(TBitmapFileHeader)+DIBInfoSize;
FSize := SizeOf(TBitmapFileHeader) + DIBInfoSize + DataSize; { neue Dateigröße errechnen }
Dlg^.Done;
end;
SetCursor(OldCursor);
end;
procedure TGraphWindow.ResizeBmp(NewW,NewH: integer);
var NewDIB: pointer;
NewDIBSize: longint;
begin
with DIBInfo^.bmiHeader do begin
if (biBitCount <> 8) and (biBitCount <> 24) then exit; { zur Sicherheit... }
NewDIBSize := longint(NewW)*NewH*(biBitCount shr 3); { neue Größe der Bilddaten ermitteln }
NewDIB := GlobalAllocPtr(GHND,NewDIBSize);
if NewDIB = nil then begin
MessageBox(HWindow,str_KeinRAM,'',mb_OK or mb_IconExclamation);
exit;
end;
if biBitCount = 8 then Resize8(DIBData^,NewDIB^,DIBInfo,NewW,NewH) { aus BILDMANI.PAS }
else if biBitCount = 24 then Resize24(DIBData^,NewDIB^,DIBInfo,NewW,NewH);
GlobalFreePtr(DIBData); { alte Bilddaten löschen, Zeiger auf neue setzen }
DIBData := NewDIB;
DataSize := NewDIBSize;
biWidth := NewW; { richtige Einträge in DIBInfo }
biHeight := NewH;
FSize := SizeOf(TBitmapFileHeader) + DIBInfoSize + DataSize;
end;
end;
procedure TGraphWindow.SaveUndoFile;
begin
BMPHeader.bfSize := SizeOf(TBitmapFileHeader) + DIBInfoSize + DataSize; { Dateigröße auch im Dateiheader setzen }
SaveBMP(UndoDateiname);
UndoValid := true;
end;
procedure TMainWindow.GetUndo;
var OldFType: byte;
begin
if not GraphWnd^.UndoValid then exit;
OldFType := GraphWnd^.FType;
GraphWnd^.LoadBMP(GraphWnd^.UndoDateiname);
GraphWnd^.FType := OldFType; { "Echtes" Format wieder einstellen, da LoadBMP FType auf t_BMP setzt }
GraphWnd^.UndoValid := false;
end;
constructor TMainWindow.Init(AParent: PWindowsObject; ATitle: PChar);
begin
inherited Init(AParent, ATitle);
ScrWidth := GetSystemMetrics(sm_CXFullScreen);
ScrHeight := GetSystemMetrics(sm_CYFullScreen) + GetSystemMetrics(sm_CYCaption); { Da sm_CYFullScreen nur die
größtmöglichen Ausmaße des Client-Windows angibt, muß die Titelzeile
noch dazugerechnet werden }
attr.x := ScrWidth div 2 - 250;
attr.y := ScrHeight div 2 - 200;
attr.w := 500;
attr.h := 400;
attr.Menu := LoadMenu(HInstance,'MainMenu');
Statuszeile := New(PStatuszeile,Init(@self));
Statuszeile^.SetText(str_About);
Changed := false;
GraphWnd := New(PGraphWindow,Init(@self));
Toolbar := New(PToolbar, Init(@Self, 'Toolbar_1', tbHorizontal));
ZoomDisable;
StrCopy(Dateiname,'keine Datei geladen');
Akt_Menus;
end;
procedure TMainWindow.GetWindowClass(var WndClass: TWndClass);
begin
inherited GetWindowClass(WndClass);
WndClass.hbrBackGround := color_AppWorkspace+1; { Grauer Hintergrund wie bei MDI-Anwendungen }
end;
{ In die neue Fenstergröße muß auch der Platz, den z.B. die Menüzeile beansprucht, eingerechnet werden.
Danach muß unbedingt AdjustScrollers aufgerufen werden, da die neue Fenstergröße Scroller entweder überflüssig
macht oder neue erfordert - deshalb wird in dieser Prozedur auch noch kein wm_Paint erzwungen (letzter Parameter
von MoveWindow ist false) }
procedure TMainWindow.ResizeWnd(NewW,NewH: longint);
begin
if WndMaximized then exit; { Wenn das Programm quasi im Vollbildmodus läuft, sollten keine Veränderungen
an der Fenstergröße vorgenommen werden }
with GraphWnd^ do begin
NewW := Round(ZoomX * NewW); { "echte" neue Breite/Höhe errechnen, also unter Berücksichtigung von Zoomstufe }
NewH := Round(ZoomY * NewH); { und Platzbedarf von Titel, Menüzeile, Toolbar, Statuszeile, Scollern und Rahmen }
NewW := NewW + 2*GetSystemMetrics(sm_CXFrame);
NewH := NewH + 2*GetSystemMetrics(sm_CYFrame) + GetSystemMetrics(sm_CYCaption) + GetSystemMetrics(sm_CYMenu) +
Toolbar^.attr.h + 20 - 2;
{ ^ Höhe der Statuszeile }
end;
if NewW < 400 then NewW := 400;
if NewH < 100 then NewH := 100; { Eine bestimmte Größe (v.a. Breite) des Fensters muß bewahrt werden - sonst
treten unangenehme, nicht einkalkulierte Umstände auf, z.B. wird die Toolbar abgeschnitten oder das Menü
auf mehrere Zeilen "aufgeteilt". Der Benutzer selbst kann das Fenster aber natürlich unter diese Grenzen
verkleinern. }
if NewW > ScrWidth then NewW := ScrWidth; { neue Breite/Höhe darf nicht größer als der Bildschirm sein... }
if NewH > ScrHeight then NewH := ScrHeight;
MoveWindow(HWindow,ScrWidth div 2 - NewW div 2,ScrHeight div 2 - NewH div 2,NewW,NewH,false);
InvalidateRect(HWindow,nil,false); { Damit alles neu gezeichnet wird }
end;
procedure TMainWindow.SetzeStatuszeile;
var s,trans: array[0..100] of char;
ArgList: array[0..10] of longint;
begin
with GraphWnd^ do begin
if FType = kein then begin
StatusZeile^.SetText(str_About);
exit;
end;
if FType = t_BMP then begin
StrCopy(s,str_BMP+', ');
if DIBInfo^.bmiHeader.biCompression = bi_RGB then StrCat(s,'unkomprimiert, ')
else StrCat(s,'RLE-komprimiert, ');
ArgList[0] := DIBInfo^.bmiHeader.biBitCount;
end;
if FType = t_TGA then begin
{ Bei komprimierten (Targa-)Bildern zeigt das Programm nur gleich nach dem Laden des Bildes die korrekte Dateigröße
an - nach der Anwendung von Effekten usw. wird die UNKOMPRIMIERTE Dateigröße ausgegeben }
StrCopy(s,str_TGA+', ');
if ((TGAInfo.TGAHeader.ImageType = TGA_ImageRGBRLE) or (TGAInfo.TGAHeader.ImageType = TGA_ImageColorMappedRLE)) and
(FSize = TGAInfo.FSize) then StrCat(s,'RLE-komprimiert, ')
else StrCat(s,'unkomprimiert, ');
if (DIBInfo^.bmiHeader.biBitCount = 24) and (not Changed) then
ArgList[0] := TGAInfo.TGAHeader.BitCount { Es kann nicht einfach die DIBInfo-Bittiefe verwendet werden, }
else ArgList[0] := DIBInfo^.bmiHeader.biBitCount; { da BMP ja keine 16 Bit-Bilder unterstützt, Targa aber schon }
end;
if FType = t_PCX then begin
StrCopy(s,str_PCX+', ');
ArgList[0] := DIBInfo^.bmiHeader.biBitCount;
end;
ArgList[1] := DIBInfo^.bmiHeader.biWidth;
ArgList[2] := DIBInfo^.bmiHeader.biHeight;
ArgList[3] := FSize div 1024;
wvsprintf(trans,'%lu bpp, %lux%lu, %lu KB',ArgList); { mit wvsprintf kann ein ganzer String "formatiert" werden,
es können also Zahlen oder Zeichenketten an bestimmten Positionen eingefügt werden }
StrCat(s,trans);
if Changed then StrCat(s,' (geändert)');
end;
Statuszeile^.SetText(s);
end;
procedure TMainWindow.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
var OldCursor: HCursor;
WndCaption: array[0..255] of char;
s: array[0..255] of char;
ArgList: record
ProgTitel: pointer;
Name: pointer;
Zoom: longint;
end;
begin
inherited Paint(PaintDC,PaintInfo);
FillChar(WndCaption,SizeOf(WndCaption),0); { die Titelzeile zusammensetzen (Programmtitel, Dateiname, Zoomstufe) }
ArgList.ProgTitel := PChar(str_ProgName);
StrCopy(s,Dateiname);
StrLower(s);
ArgList.Name := @s;
ArgList.Zoom := Round(GraphWnd^.ZoomX*100);
wvsprintf(WndCaption,'%s - [%s] - %li %%',ArgList);
SetWindowText(HWindow,WndCaption);
SetzeStatuszeile; { auch Statuszeile neu zeichnen }
end;
procedure TMainWindow.WMSize(var Msg: TMessage);
var r: TRect;
begin
inherited WMSize(Msg);
GetClientRect(HWindow,r);
SendMessage(ToolBar^.HWindow, am_CalcParentClientRect, AllowRepaint, Longint(@R)); { Damit die Toolbar sich
"einrichten" kann }
{ erst nach der Toolbar werden GraphWnd und Statuszeile an die neue Fenstergröße angepaßt }
MoveWindow(GraphWnd^.HWindow,0,ToolBar^.attr.h-1,r.right+1,r.bottom-ToolBar^.attr.h-18,true);
MoveWindow(Statuszeile^.HWindow,0,r.bottom-19,r.right+1,20,true);
WndMaximized := (Msg.wParam = SIZE_MAXIMIZED); { wenn der Benutzer das Vollbild-Icon betätigt hat }
end;
procedure TMainWindow.cmDateiOeffnen(var Msg: TMessage);
const DefExt = 'bmp';
var OpenFN: TOpenFileName; { Ausgewählter Dateiname }
Filter: array[0..200] of char;
Ext: array[0..2] of char;
Dlg: PFortschrittDlg;
Result: integer;
LadeDateiname: array[0..255] of char; { zu ladende Datei }
begin
Dlg := New(PFortschrittDlg,Init(@self));
StrCopy(LadeDateiname, '');
FillChar(Filter,SizeOf(Filter),#0); { -> C-Konvention - nullterminierter String! }
StrCopy(@Filter,str_AlleDateien); { Eintrag für Dateifilter setzen }
StrCopy(@Filter[StrLen(Filter)+1],'*.bmp;*.pcx;*.tga');
FillChar(OpenFN,SizeOf(OpenFN),#0);
with OpenFN do begin { Standardoptionen für den Datei-Öffnen-Dialog setzen }
hInstance := HInstance;
hwndOwner := HWindow;
lpstrDefExt := DefExt;
lpstrFile := LadeDateiname;
lpstrFilter := Filter;
lpstrFileTitle := nil;
flags := ofn_FileMustExist or ofn_HideReadOnly;
lStructSize := SizeOf(TOpenFileName);
nFilterIndex := 1;
nMaxFile := SizeOf(LadeDateiname);
end;
if GetOpenFileName(OpenFN) then begin
SetCursor(LoadCursor(0,idc_Wait)); { Sanduhr anzeigen }
Dlg^.Create;
Dlg^.SetText('Öffne Datei...');
StrLCopy(@Ext,@LadeDateiname[StrLen(LadeDateiname)-3],3); { Erweiterung lesen }
if Ext = 'BMP' then Result := GraphWnd^.LoadBMP(LadeDateiName);{ je nach Erweiterung die entsprechende Lade-prozedur }
if Ext = 'TGA' then Result := GraphWnd^.LoadTGA(LadeDateiName); { aufrufen }
if Ext = 'PCX' then Result := GraphWnd^.LoadPCX(LadeDateiName);
Dlg^.Done;
SetCursor(LoadCursor(0,idc_Arrow));
if Result <> 0 then begin { eventuelle Fehlermeldungen oder Hinweise ausgeben }
if (Result and err_Oeffnen <> 0) or (Result and err_RAM <> 0) or (Result and err_Format <> 0) or
(Result and err_WenigFarben <> 0) then begin
if Result and err_Oeffnen <> 0 then MessageBox(HWindow,str_FehlerOeffnen,str_Fehler,mb_IconExclamation or mb_OK);
if Result and err_RAM <> 0 then MessageBox(HWindow,str_KeinRAM,str_Fehler,mb_IconExclamation or mb_OK);
if Result and err_Format <> 0 then MessageBox(HWindow,str_Format,str_Fehler,mb_IconExclamation or mb_OK);
if Result and err_WenigFarben <> 0 then MessageBox(HWindow,str_WenigFarben,str_Hinweis,mb_IconExclamation or mb_OK);
if (Result and err_WenigFarben <> 0) and (GraphWnd^.FType = t_BMP) then
{ Sonderfall: BMP-Dateien mit zu geringer Farbtiefe können schon angezeigt werden,
aber nicht bearbeitet }
else begin
with GraphWnd^ do begin { falls noch Bilddaten vorhanden sind, löschen }
if DataSize <> 0 then GlobalFreePtr(DIBData);
DataSize := 0;
FreeMem(DIBInfo,DIBInfoSize);
DIBInfo := MemAlloc(SizeOf(TBitmapInfoHeader));
DIBInfoSize := SizeOf(TBitmapInfoHeader);
FillChar(DIBInfo^,DIBInfoSize,0);
FType := kein;
ZoomX := 1; ZoomY := 1; { Standardeinstellungen setzen }
end;
ResizeWnd(500,300);
StrCopy(Dateiname,'keine Datei geladen');
Akt_Menus;
GraphWnd^.AdjustScrollers;
exit;
end;
end;
{ Die folgenden zwei "Fehler" sind eigentlich nur Warnungen, da das Programm diese Dateien nicht voll
unterstützt }
if Result and err_Komprimiert <> 0 then MessageBox(HWindow,str_Komprimiert,str_Hinweis,mb_IconExclamation or mb_OK);
if Result and err_PalBild <> 0 then MessageBox(HWindow,str_PalBild,str_Hinweis,mb_IconExclamation or mb_OK);
end;
with GraphWnd^.DIBInfo^.bmiHeader do { falls das Bitmap nicht auf 32-Bit-Grenzen ausgerichtet ist, wird es
hier geringfügig vergrößert, um eine problemlose Bearbeitung zu ermöglichen,
falls der Benutzer es wünscht }
if biWidth mod 4 <> 0 then
if MessageBox(HWindow,str_Grenze32,str_Fehler,mb_YesNo or mb_IconExclamation) = id_Yes then
GraphWnd^.ResizeBmp((biWidth div 4 + 1)*4,biHeight)
else begin
with GraphWnd^ do begin { Bilddaten usw. löschen, falls das Bild nicht vergrößert werden soll }
GlobalFreePtr(DIBData);
DataSize := 0;
FreeMem(DIBInfo,DIBInfoSize);
DIBInfo := MemAlloc(SizeOf(TBitmapInfoHeader));
DIBInfoSize := SizeOf(TBitmapInfoHeader);
FillChar(DIBInfo^,DIBInfoSize,0);
FType := kein;
ZoomX := 1; ZoomY := 1;
end;
ResizeWnd(500,300);
StrCopy(Dateiname,'keine Datei geladen');
Akt_Menus;
GraphWnd^.AdjustScrollers;
exit;
end;
StrCopy(Dateiname,LadeDateiname);
GraphWnd^.UndoValid := false; { eine ev. vorhandene Undodatei ist natürlich unnütz }
Akt_Menus;
GraphWnd^.ZoomX := 1; GraphWnd^.ZoomY := 1; { kein Zoom }
SetZoomCheck(cm_Zoom100);
Changed := false;
with GraphWnd^ do begin { Fenstergröße und Scroller dem neuen Bild anpassen }
ResizeWnd(DIBInfo^.bmiHeader.biWidth,DIBInfo^.bmiHeader.biHeight);
AdjustScrollers;
end;
InvalidateRect(HWindow,nil,false);
end;
end;
procedure TMainWindow.cmDateiSpeichern(var Msg: TMessage);
var Dlg: PFortschrittDlg;
OldCursor: HCursor;
begin
OldCursor := SetCursor(LoadCursor(0,idc_Wait));
Dlg := New(PFortschrittDlg,Init(@self));
Dlg^.Create;
Dlg^.SetText('Schreibe Datei...');
with GraphWnd^ do
if fType = t_BMP then begin
FSize := SizeOf(TBitmapFileHeader) + DIBInfoSize + DataSize;
BMPHeader.bfSize := FSize;
SaveBMP(DateiName);
end
else if fType = t_TGA then SaveTGA(DateiName)
else if fType = t_PCX then SavePCX(DateiName);
Dlg^.Done;
SetCursor(OldCursor);
end;
procedure TMainWindow.cmDateiSpeichernUnter(var Msg: TMessage);
var FormatDlg: PFormatDlg;
FDlg: PFortschrittDlg;
TransBuf: record
BMP,TGA,PCX,
_8bpp,_16bpp,_24bpp,
Unkomprimiert,RLE: bool;
InfoText: array[0..200] of char;
end;
OpenFN: TOpenFileName;
Filter: array[0..100] of char;
FileTitle: array[0..254] of char;
Dir,Name: array[0..254] of char;
DateiNameNeu: array[0..255] of char;
Ext: array[0..3] of char;
TGAInfoSav: TTGAInfo;
OK: boolean;
begin
OK := false;
with TransBuf do begin { den Transferbuffer für den Formatdialog initialisieren }
BMP := true; { (Format: BMP, 24 Bit, unkomprimiert) }
TGA := false;
PCX := false;
_8bpp := false;
_16bpp := false;
_24bpp := true;
Unkomprimiert := true;
RLE := false;
FillChar(InfoText,201,0);
end;
FormatDlg := New(PFormatDlg,Init(@self));
FormatDlg^.TransferBuffer := @TransBuf; { für den Austausch von Daten }
if Application^.ExecDialog(FormatDlg) <> id_OK then exit;
GraphWnd^.SaveUndoFile; { Falls die Bilddaten durch die Auswahl im Format-Dialog verändert werden (andere
Farbtiefe), sollte diese vorübergehende Änderung nicht sichtbar sein und keine
Auswirkungen auf das aktive Bild haben }
TGAInfoSav := GraphWnd^.TGAInfo;
with GraphWnd^.DIBInfo^.bmiHeader do
with TransBuf do begin { die Standardoptionen für den Datei-Schreiben-Dialog setzen }
StrCopy(DateinameNeu,'');
FillChar(Filter,SizeOf(Filter),#0);
if BMP = true then begin
StrCopy(Filter,str_BMP);
StrCopy(@Filter[StrLen(Filter)+1],'*.bmp');
end
else if TGA = true then begin
StrCopy(Filter,str_TGA);
StrCopy(@Filter[StrLen(Filter)+1],'*.tga');
end
else if PCX = true then begin
StrCopy(Filter,str_PCX);
StrCopy(@Filter[StrLen(Filter)+1],'*.pcx');
end;
FillChar(OpenFN,SizeOf(OpenFN),#0);
with OpenFN do begin
hInstance := HInstance;
hwndOwner := HWindow;
lpstrFile := DateinameNeu;
lpstrFilter := Filter;
lpstrFileTitle := FileTitle;
lStructSize := SizeOf(TOpenFileName);
nFilterIndex := 1;
nMaxFile := SizeOf(DateinameNeu);
flags := ofn_OverWritePrompt or ofn_HideReadOnly;
if BMP = true then lpstrDefExt := 'bmp'
else if TGA = true then lpstrDefExt := 'tga'
else if PCX = true then lpstrDefExt := 'pcx';
end;
if GetSaveFileName(OpenFN) then begin
FDlg := New(PFortschrittDlg,Init(@self));
FDlg^.Create;
FDlg^.SetText('Schreibe Datei...');
SetCursor(LoadCursor(0,idc_Wait));
{ Datei ev. noch in die richtige Farbtiefe umwandeln }
if ((_24bpp = true) or (_16bpp = true)) and (biBitCount = 8) then begin
GraphWnd^.Konv8zu24; { wenn die gewünschte Farbtiefe größer als 8bpp ist }
InvalidateRect(HWindow,nil,false);
end
else if (_8bpp = true) and (biBitCount = 24) then begin
GraphWnd^.Konv24zu8; { wenn die gewünschte Farbtiefe 8bpp ist, das Bild aber in 24bpp vorliegt }
InvalidateRect(HWindow,nil,false);
end;
if BMP = true then GraphWnd^.SaveBMP(DateinameNeu) { Je nach Auswahl den erforderlichen Saver ausführen }
else if TGA = true then { Der Targa-Saver benötigt eigene Informationen: über die Farbtiefe, die auch
16bpp betragen kann, außerdem muß ImageType gesetzt werden }
with GraphWnd^.TGAInfo.TGAHeader do begin
if _8bpp then BitCount := 8
else if _16bpp then BitCount := 16
else if _24bpp then BitCount := 24;
if RLE = true then
if BitCount >= 16 then ImageType := TGA_ImageRGBRLE
else if BitCount = 8 then ImageType := TGA_ImageColorMappedRLE
else
else
if BitCount >= 16 then ImageType := TGA_ImageRGB
else if BitCount = 8 then ImageType := TGA_ImageColorMapped;
GraphWnd^.SaveTGA(DateiNameNeu);
end
else if PCX = true then
GraphWnd^.SavePCX(DateiNameNeu);
FDlg^.Done;
OK := true;
end;
end; { ... with ... }
GraphWnd^.TGAInfo := TGAInfoSav;
GetUndo;
SetCursor(LoadCursor(0,idc_Arrow));
if OK then begin
StrCat(DateiNameNeu,str_Gespeichert); { "Erfolgsmeldung" ausgeben }
MessageBox(HWindow,DateiNameNeu,str_Hinweis,mb_OK or mb_IconInformation);
end;
end;
procedure TMainWindow.cmUndo(var Msg: TMessage);
var OldCursor: HCursor;
begin
OldCursor := SetCursor(LoadCursor(0,idc_Wait));
GetUndo; { Undodatei laden }
Akt_Menus;
SetCursor(OldCursor);
GraphWnd^.AdjustScrollers;
InvalidateRect(HWindow,nil,true);
end;
procedure TMainWindow.cmFensterAnpassen(var Msg: TMessage);
begin
with GraphWnd^ do begin
ResizeWnd(DIBInfo^.bmiHeader.biWidth,DIBInfo^.bmiHeader.biHeight);
AdjustScrollers;
end;
InvalidateRect(HWindow,nil,false);
end;
procedure TMainWindow.cmZoom25(var Msg: TMessage);
begin
with GraphWnd^ do begin
ZoomX := 0.25; ZoomY := 0.25;
SetZoomCheck(cm_Zoom25);
AdjustScrollers;
end;
InvalidateRect(HWindow,nil,true);
end;
procedure TMainWindow.cmZoom50(var Msg: TMessage);
begin
with GraphWnd^ do begin
ZoomX := 0.5; ZoomY := 0.5;
SetZoomCheck(cm_Zoom50);
AdjustScrollers;
end;
InvalidateRect(HWindow,nil,true);
end;
procedure TMainWindow.cmZoom75(var Msg: TMessage);
begin
with GraphWnd^ do begin
ZoomX := 0.75; ZoomY := 0.75;
SetZoomCheck(cm_Zoom75);
AdjustScrollers;
end;
InvalidateRect(HWindow,nil,true);
end;
procedure TMainWindow.cmZoom100(var Msg: TMessage);
begin
with GraphWnd^ do begin
ZoomX := 1; ZoomY := 1;
SetZoomCheck(cm_Zoom100);
AdjustScrollers;
end;
InvalidateRect(HWindow,nil,true);
end;
procedure TMainWindow.cmZoom150(var Msg: TMessage);
begin
with GraphWnd^ do begin
ZoomX := 1.5; ZoomY := 1.5;
SetZoomCheck(cm_Zoom150);
AdjustScrollers;
end;
InvalidateRect(HWindow,nil,true);
end;
procedure TMainWindow.cmZoom200(var Msg: TMessage);
begin
with GraphWnd^ do begin
ZoomX := 2; ZoomY := 2;
SetZoomCheck(cm_Zoom200);
AdjustScrollers;
end;
InvalidateRect(HWindow,nil,true);
end;
procedure TMainWindow.cmZoom400(var Msg: TMessage);
begin
with GraphWnd^ do begin
ZoomX := 4; ZoomY := 4;
SetZoomCheck(cm_Zoom400);
AdjustScrollers;
end;
InvalidateRect(HWindow,nil,true);
end;
procedure TMainWindow.cmZoom800(var Msg: TMessage);
begin
with GraphWnd^ do begin
ZoomX := 8; ZoomY := 8;
SetZoomCheck(cm_Zoom800);
AdjustScrollers;
end;
InvalidateRect(HWindow,nil,true);
end;
procedure TMainWindow.cmBildAnpassen(var Msg: TMessage);
begin
with GraphWnd^ do begin
StretchBMP := true;
StretchBitmap;
AdjustScrollers;
SetZoomCheck(cm_BildAnpassen);
end;
InvalidateRect(HWindow,nil,true);
end;
procedure TMainWindow.cmAttributeAnzeigen(var Msg: TMessage);
var dlg: PDialog;
trans: array[0..2000] of char; { der Informationstext }
tmp: array[0..100] of char;
txt: PEdit;
FS: longint;
ArgList: array[0..5] of longint;
procedure ClearTmp;
begin
FillChar(tmp,SizeOf(tmp),0);
end;
begin
dlg := New(PDialog,Init(@self,'Attribute'));
txt := New(PEdit,InitResource(dlg,id_AttrText,SizeOf(trans))); { Resource initialisieren }
FillChar(trans,SizeOf(trans),0);
ClearTmp;
StrCopy(trans,'Dateityp: '#9); { #9 ...... Tabulator }
with GraphWnd^ do begin
if FType = t_BMP then StrCat(trans,'Windows BMP'#13#10);
if FType = t_PCX then StrCat(trans,'ZSoft PCX'#13#10);
if FType = t_TGA then StrCat(trans,'Targa Image File Format (TGA)'#13#10);
ArgList[0] := DIBInfo^.bmiHeader.biWidth; ArgList[1] := DIBInfo^.bmiHeader.biHeight;
wvsprintf(tmp,'Bildgröße: '#9'%lux%lu Pixel'#13#10,ArgList);
StrCat(trans,tmp);
ClearTmp;
if FType = t_TGA then
if (DIBInfo^.bmiHeader.biBitCount = 24) and (not Changed) then
ArgList[0] := TGAInfo.TGAHeader.BitCount { Es kann bei TGA nicht einfach die DIBInfo-Bittiefe verwendet werden, }
else ArgList[0] := DIBInfo^.bmiHeader.biBitCount { da BMP ja keine 16 Bit-Bilder unterstützt, Targa aber schon }
else ArgList[0] := DIBInfo^.bmiHeader.biBitCount;
if ArgList[0] = 16 then ArgList[1] := 1 shl (ArgList[0]-1) { bei 16bpp werden nur 15 Bit für die Farbe
verwendet, 1 bedeutungsloses Attributbit }
else ArgList[1] := 1 shl ArgList[0];
wvsprintf(tmp,'Farbtiefe: '#9'%lu Bits/Pixel (%lu Farben)'#13#10,ArgList);
StrCat(trans,tmp);
StrCat(trans,'Kompression: '#9);
if FType = t_BMP then
with DIBInfo^.bmiHeader do
case biCompression of
BI_RGB: StrCat(trans,'keine');
BI_RLE8: StrCat(trans,'RLE8 (lauflängenkomprimiert)');
BI_RLE4: StrCat(trans,'RLE4 (lauflängenkomprimiert)');
end
else if (FType = t_PCX) or ((FType = t_TGA) and ((TGAInfo.TGAHeader.ImageType = TGA_ImageRGBRLE)
or (TGAInfo.TGAHeader.ImageType = TGA_ImageColorMappedRLE))) then
StrCat(trans,'RLE (lauflängenkomprimiert)')
else StrCat(trans,'keine');
StrCat(trans,#13#10);
end; { ...with GraphWnd^ }
dlg^.TransferBuffer := @trans;
Application^.ExecDialog(dlg);
end;
procedure TMainWindow.cmHistogrammAnzeigen(var Msg: TMessage);
var dlg: PHistoDlg;
FDlg: PFortschrittDlg;
Histogramm: THistogramm;
OldCursor: HCursor;
ctr,ctr8,AnzPixels: longint;
RGB: TRGBQuad;
hell: byte;
faktor: real;
begin
if GraphWnd^.DIBInfo^.bmiHeader.biBitCount <> 24 then exit;
OldCursor := SetCursor(LoadCursor(0,idc_Wait));
FDlg := New(PFortschrittDlg,Init(@self));
FDlg^.Create;
FDlg^.SetText('Erstelle Histogramm...');
ctr8 := 0;
FillChar(Histogramm,SizeOf(THistogramm),0);
faktor := Sqrt(3*(255*255))/255; { Korrekturfaktor, damit die Helligkeit in 255 Einträge paßt }
with GraphWnd^.DIBInfo^.bmiHeader do begin
AnzPixels := biWidth*biHeight;
with Histogramm do
for ctr := 1 to AnzPixels do begin { jedes Pixel ins Histogramm einbeziehen }
GetPixel24(ctr8,GraphWnd^.DIBData^,RGB);
with RGB do begin { Helligkeit berechnen }
hell := Round(Sqrt(longint(rgbRed)*rgbRed + longint(rgbGreen)*rgbGreen + longint(rgbBlue)*rgbBlue)*faktor);
Inc(Helligkeit[hell]); { die entsprechenden Histogrammeinträge erhöhen }
Inc(Rot[rgbRed]); { die Einträge für die einzelnen Farbkomponenten können }
Inc(Gruen[rgbGreen]); { direkt erhöht werden }
Inc(Blau[rgbBlue]);
end;
Inc(ctr8,3);
end;
end;
with Histogramm do
for ctr := 0 to 255 do begin { das Maximum für jedes Histogramm ermitteln }
if Helligkeit[ctr] > MaxHelligkeit then MaxHelligkeit := Helligkeit[ctr];
if Rot[ctr] > MaxRot then MaxRot := Rot[ctr];
if Gruen[ctr] > MaxGruen then MaxGruen := Gruen[ctr];
if Blau[ctr] > MaxBlau then MaxBlau := Blau[ctr];
end;
FDlg^.Done;
SetCursor(OldCursor);
dlg := New(PHistoDlg,Init(@self,@Histogramm));
Application^.ExecDialog(dlg); { und das Histogramm anzeigen }
end;
procedure TMainWindow.cmFarbtiefe8bpp(var Msg: TMessage);
begin
GraphWnd^.SaveUndoFile;
with GraphWnd^ do
if DIBInfo^.bmiHeader.biBitCount = 24 then Konv24zu8;
InvalidateRect(HWindow,nil,false);
Akt_Menus;
Changed := true;
end;
procedure TMainWindow.cmFarbtiefe24bpp(var Msg: TMessage);
begin
GraphWnd^.SaveUndoFile;
with GraphWnd^ do
if DIBInfo^.bmiHeader.biBitCount = 8 then Konv8zu24;
InvalidateRect(HWindow,nil,false);
Akt_Menus;
Changed := true;
end;
procedure TMainWindow.cmHelligkeit(var Msg: TMessage);
var dlg: PHelligkeitDlg;
Prozent,NeueHelligkeit: integer;
RetVal: integer;
OldCursor: HCursor;
begin
GraphWnd^.SaveUndoFile;
Prozent := 10;
repeat
dlg := New(PHelligkeitDlg,Init(@self));
dlg^.TransferBuffer := @Prozent; { Die einzige Variable, die im Dialog verändert wird, ist
Proz (durch die Scrollbar) }
RetVal := dlg^.Execute; { Dialog ausführen... }
if RetVal <> 2 then begin { wenn nicht Cancel ausgewählt wurde, Helligkeit verändern }
Changed := true;
OldCursor := SetCursor(LoadCursor(0,idc_Wait));
if RetVal = id_AufHellen then NeueHelligkeit := Prozent+100 { Aufhellen -> der eingestellt Prozentsatz muß auf 100
addiert werden }
else NeueHelligkeit := 100-Prozent; { Abdunkeln -> Prozentsatz subtrahieren }
with GraphWnd^ do begin
if DIBInfo^.bmiHeader.biBitCount = 8 then Helligkeit8(DIBInfo^.bmiColors,NeueHelligkeit);
if DIBInfo^.bmiHeader.biBitCount = 24 then with DIBInfo^.bmiHeader do
Helligkeit24(DIBData^,biWidth*biHeight,NeueHelligkeit);
end;
InvalidateRect(HWindow,nil,false);
SetCursor(OldCursor);
end;
dlg^.Done;
until RetVal = 2;
Akt_Menus;
end;
procedure TMainWindow.cmResize(var Msg: TMessage);
var dlg: PDialog;
TransBuf: record
NewW,
NewH: array[0..10] of char;
BildAnpassen,BildNichtAnpassen: bool;
end;
NewW,NewH: longint;
ed: PEdit;
validator: PFilterValidator;
ValResult: integer;
OldCursor: HCursor;
FDlg: PFortschrittDlg;
begin
GraphWnd^.SaveUndoFile;
dlg := New(PDialog,Init(@self,'RESIZEDLG')); { Dialog aus der Resourcendatei laden }
FDlg := New(PFortschrittDlg,Init(@self));
validator := New(PFilterValidator,Init(['0'..'9'])); { damit nur Zahlen eingegeben werden können }
New(ed,InitResource(dlg,id_NewWInput,SizeOf(TransBuf.NewW)));
ed^.Validator := validator;
New(ed,InitResource(dlg,id_NewHInput,SizeOf(TransBuf.NewH)));
validator := New(PFilterValidator,Init(['0'..'9']));
ed^.Validator := validator;
with GraphWnd^.DIBInfo^.bmiHeader do begin
wvsprintf(TransBuf.NewW,'%d',biWidth); { die Eingabefelder auf die aktuelle Bildgröße setzen }
wvsprintf(TransBuf.NewH,'%d',biHeight);
end;
TransBuf.BildAnpassen := true; TransBuf.BildNichtAnpassen := false;
dlg^.TransferBuffer := @TransBuf;
if Application^.ExecDialog(dlg) <> id_OK then exit;
Val(TransBuf.NewW,NewW,ValResult); { die eingegebenen neuen Ausmaße ermitteln }
Val(TransBuf.NewH,NewH,ValResult);
if (NewW > MaxInt) or (NewH > MaxInt) then begin
MessageBox(HWindow,str_XYzuGross,str_Fehler,mb_OK or mb_IconExclamation);
exit;
end;
if (NewW <= 5) or (NewH <= 5) then begin
MessageBox(HWindow,str_XYzuKlein,str_Fehler,mb_OK or mb_IconExclamation);
exit;
end;
if NewW mod 4 <> 0 then
if MessageBox(HWindow,str_Grenze32,str_Fehler,mb_YesNo or mb_IconExclamation) = id_Yes then
NewW := (NewW div 4 + 1)*4;
OldCursor := SetCursor(LoadCursor(0,idc_Wait));
FDlg^.Create;
FDlg^.SetText('Berechne neues Bild...');
GraphWnd^.ResizeBmp(NewW,NewH);
FDlg^.Done;
SetCursor(OldCursor);
InvalidateRect(HWindow,nil,true);
GraphWnd^.AdjustScrollers;
Akt_Menus;
Changed := true;
end;
procedure TMainWindow.WendeMaskeAn(Maske: TMaske; txt: PChar);
var NewDIB24: pointer;
OldCursor: HCursor;
dlg: PFortschrittDlg;
begin
if GraphWnd^.DIBInfo^.bmiHeader.biBitCount <> 24 then exit;{ funktioniert nur mit 24bpp }
NewDIB24 := GlobalAllocPtr(GHND,GraphWnd^.DataSize);
{ ein zweites DIB mit derselben Größe anfordern }
if NewDIB24 = nil then begin
MessageBox(HWindow,str_KeinRAM,str_Fehler,mb_OK or mb_IconExclamation);
exit;
end;
dlg := New(PFortschrittDlg,Init(@self));
dlg^.Create;
dlg^.SetText(txt);
GraphWnd^.SaveUndoFile;
OldCursor := SetCursor(LoadCursor(0,idc_Wait));
LokalOp24(GraphWnd^.DIBData^,NewDIB24^,GraphWnd^.DIBInfo,GraphWnd^.DataSize div 3,Maske);
GlobalFreePtr(GraphWnd^.DIBData); { altes DIB löschen }
GraphWnd^.DIBData := NewDIB24; { Zeiger auf neues DIB setzen }
SetCursor(OldCursor);
dlg^.Done;
InvalidateRect(HWindow,nil,true);
Akt_Menus;
Changed := true;
end;
procedure TMainWindow.cmMittelwert(var Msg: TMessage);
begin
WendeMaskeAn(Mittelwert,'Wende Mittelwertmaske an...');
end;
procedure TMainWindow.cmLaplace(var Msg: TMessage);
begin
WendeMaskeAn(Laplace,'Wende Laplacemaske an...');
end;
procedure TMainWindow.cmAbout(var Msg: TMessage);
begin
MessageBox(HWindow,str_About,str_Info,mb_OK or mb_IconInformation);
end;
procedure TMainWindow.EnableItem(cm: word; Enabled: word);
begin
EnableMenuItem(attr.Menu,cm,mf_ByCommand or Enabled);
if Enabled = mf_Enabled then ToolBar^.EnableTool(cm,true)
else ToolBar^.EnableTool(cm,false);
end;
procedure TMainWindow.Akt_Menus;
var Enabled: word;
begin
with GraphWnd^.DIBInfo^.bmiHeader do
if GraphWnd^.FType = kein then begin
EnableItem(cm_DateiSpeichern,mf_Grayed);
EnableItem(cm_DateiSpeichernUnter,mf_Grayed);
EnableItem(cm_AttributeAnzeigen,mf_Grayed);
EnableItem(cm_HistogrammAnzeigen,mf_Grayed);
EnableItem(cm_Farbtiefe8bpp,mf_Grayed);
EnableItem(cm_Farbtiefe24bpp,mf_Grayed);
EnableItem(cm_Helligkeit,mf_Grayed);
EnableItem(cm_Vergroessern,mf_Grayed);
EnableItem(cm_Mittelwert,mf_Grayed);
EnableItem(cm_Laplace,mf_Grayed);
ZoomDisable;
EnableItem(cm_FensterAnpassen,mf_Grayed);
EnableItem(cm_Undo,mf_Grayed);
end
else begin
EnableItem(cm_FensterAnpassen,mf_Enabled);
EnableItem(cm_AttributeAnzeigen,mf_Enabled);
ZoomEnable;
if (biCompression <> bi_RGB) or (biBitCount < 8) then Enabled := mf_Grayed
else if biBitCount >= 8 then Enabled := mf_Enabled;
EnableItem(cm_DateiSpeichern,Enabled);
EnableItem(cm_DateiSpeichernUnter,Enabled);
EnableItem(cm_Helligkeit,Enabled);
EnableItem(cm_Vergroessern,Enabled);
if (not GraphWnd^.UndoValid) then EnableMenuItem(attr.Menu,cm_Undo,mf_ByCommand or mf_Grayed)
else EnableMenuItem(attr.Menu,cm_Undo,mf_ByCommand or mf_Enabled);
if biBitCount = 24 then Enabled := mf_Enabled
else Enabled := mf_Grayed;
EnableItem(cm_Farbtiefe8bpp,Enabled); { nur mit 24bpp Farbtiefe }
EnableItem(cm_HistogrammAnzeigen,Enabled);
EnableItem(cm_Mittelwert,Enabled);
EnableItem(cm_Laplace,Enabled);
if (biBitCount = 8) and (biCompression = bi_RGB) then EnableItem(cm_Farbtiefe24bpp,mf_Enabled)
else EnableItem(cm_Farbtiefe24bpp,mf_Grayed);
end;
end;
procedure TMainWindow.ZoomDisable;
var i: integer;
begin
for i := 0 to 8 do begin
EnableMenuItem(attr.Menu,cm_Zoom25+i,mf_ByCommand or mf_Grayed);
ToolBar^.EnableTool(cm_Zoom25+i,false);
end;
end;
procedure TMainWindow.ZoomEnable;
var i: integer;
begin
for i := 0 to 8 do begin
EnableMenuItem(attr.Menu,cm_Zoom25+i,mf_ByCommand or mf_Enabled);
ToolBar^.EnableTool(cm_Zoom25+i,true);
end;
end;
procedure TMainWindow.SetZoomCheck(cm: word);
var i: integer;
begin
for i := 0 to 8 do
CheckMenuItem(attr.Menu,cm_Zoom25+i,mf_ByCommand or mf_Unchecked); { Zuerst etwaige Checkboxen entfernen }
CheckMenuItem(attr.Menu,cm,mf_ByCommand or mf_Checked);
if cm <> cm_BildAnpassen then GraphWnd^.StretchBMP := false;
end;
constructor THelligkeitDlg.Init(AParent: PWindowsObject);
begin
inherited Init(AParent,'SHADEDLG');
ScrollBar := New(PScrollBar,InitResource(@self,id_ScrollBar));
ProzText := New(PStatic,InitResource(@self,id_ProzText,100));
end;
procedure THelligkeitDlg.SetupWindow;
var s,s2: array[0..100] of char;
begin
inherited SetupWindow;
ScrollBar^.SetRange(1,100);
ScrollBar^.SetPosition(integer(TransferBuffer^));
StrCopy(s,'Um ');
Str(ScrollBar^.GetPosition,s2);
StrCat(s,s2);
StrCat(s,' Prozent verändern');
ProzText^.SetText(s);
end;
procedure THelligkeitDlg.HandleScrollBar(var Msg: TMessage);
var s,s2: array[0..100] of char;
begin
StrCopy(s,'Um ');
Str(ScrollBar^.GetPosition,s2);
StrCat(s,s2);
StrCat(s,' Prozent verändern');
ProzText^.SetText(s);
integer(TransferBuffer^) := ScrollBar^.GetPosition;
end;
procedure THelligkeitDlg.Aufhellen(var Msg: TMessage);
begin
EndDlg(id_Aufhellen);
end;
procedure THelligkeitDlg.Verdunkeln(var Msg: TMessage);
begin
EndDlg(id_Verdunkeln);
end;
constructor TFortschrittDlg.Init(AParent: PWindowsObject);
begin
inherited Init(AParent,'PROGRESSDLG');
Txt := New(PStatic,InitResource(@self,id_Text,200));
end;
procedure TFortschrittDlg.SetupWindow;
begin
inherited SetupWindow;
Txt^.SetText('');
end;
procedure TFortschrittDlg.SetText(NeuerText: PChar);
begin
Txt^.SetText(NeuerText);
end;
constructor TFormatDlg.Init(AParent: PWindowsObject);
begin
inherited Init(AParent,'FORMATDLG');
BMPRadio := New(PRadioButton,InitResource(@self,id_BMPRadio));
TGARadio := New(PRadioButton,InitResource(@self,id_TGARadio));
PCXRadio := New(PRadioButton,InitResource(@self,id_PCXRadio));
_8bppRadio := New(PRadioButton,InitResource(@self,id_8bppRadio));
_16bppRadio := New(PRadioButton,InitResource(@self,id_16bppRadio));
_24bppRadio := New(PRadioButton,InitResource(@self,id_24bppRadio));
UnkomprimiertRadio := New(PRadioButton,InitResource(@self,id_UnkomprimiertRadio));
RLERadio := New(PRadioButton,InitResource(@self,id_RLERadio));
InfoText := New(PStatic,InitResource(@self,id_InfoText,200));
end;
procedure TFormatDlg.SetupWindow;
begin
inherited SetupWindow;
if BMPRadio^.GetCheck = bf_Checked then InfoText^.SetText(str_BMPInfo);
if TGARadio^.GetCheck = bf_Checked then InfoText^.SetText(str_TGAInfo);
if PCXRadio^.GetCheck = bf_Checked then InfoText^.SetText(str_PCXInfo);
end;
procedure TFormatDlg.BMPRadioSelected(var Msg: TMessage);
begin
InfoText^.SetText(str_BMPInfo);
CheckRadioButton(HWindow,id_UnkomprimiertRadio,id_RLERadio,id_UnkomprimiertRadio);
if _16bppRadio^.GetCheck = bf_Checked then
CheckRadioButton(HWindow,id_8bppRadio,id_24bppRadio,id_24bppRadio); { BMP: kein 16bpp, keine RLE-Komprimierung! }
end;
procedure TFormatDlg.TGARadioSelected(var Msg: TMessage);
begin
InfoText^.SetText(str_TGAInfo);
end;
procedure TFormatDlg.PCXRadioSelected(var Msg: TMessage);
begin
InfoText^.SetText(str_PCXInfo);
CheckRadioButton(HWindow,id_UnkomprimiertRadio,id_RLERadio,id_RLERadio);
if _16bppRadio^.GetCheck = bf_Checked then
CheckRadioButton(HWindow,id_8bppRadio,id_24bppRadio,id_24bppRadio); { PCX: kein 16bpp, keine unkomprimierten Dateien }
end;
procedure TFormatDlg._16bppRadioSelected(var Msg: TMessage);
begin
if (BMPRadio^.GetCheck = bf_Checked) or (PCXRadio^.GetCheck = bf_Checked) then
CheckRadioButton(HWindow,id_8bppRadio,id_24bppRadio,id_24bppRadio);
end;
procedure TFormatDlg.UnkomprimiertRadioSelected(var Msg: TMessage);
begin
if PCXRadio^.GetCheck = bf_Checked then
CheckRadioButton(HWindow,id_UnkomprimiertRadio,id_RLERadio,id_RLERadio);
end;
procedure TFormatDlg.RLERadioSelected(var Msg: TMessage);
begin
if BMPRadio^.GetCheck = bf_Checked then
CheckRadioButton(HWindow,id_UnkomprimiertRadio,id_RLERadio,id_UnkomprimiertRadio);
end;
constructor THistoDlg.Init(AParent: PWindowsObject; Histo: PHistogramm);
begin
inherited Init(AParent,'HISTODLG');
HelligkeitRadio := New(PRadioButton,InitResource(@self,id_HelligkeitRadio));
RotRadio := New(PRadioButton,InitResource(@self,id_RotRadio));
GruenRadio := New(PRadioButton,InitResource(@self,id_GruenRadio));
BlauRadio := New(PRadioButton,InitResource(@self,id_BlauRadio));
LogCheckbox := New(PCheckBox,InitResource(@self,id_LogCheckbox));
Histogramm := Histo;
end;
procedure THistoDlg.SetupWindow;
begin
inherited SetupWindow;
LogCheckBox^.SetCheck(bf_Checked);
end;
procedure THistoDlg.ZeichneHistogramm;
var DC: HDC;
x,y,Max: longint;
begin
DC := GetDC(HWindow);
SelectObject(DC,GetStockObject(LtGray_Brush));
SelectObject(DC,GetStockObject(Null_Pen));
Rectangle(DC,HistoX-1,HistoY-1,HistoX+HistoW+2,HistoY+HistoH+2);
{ Histogrammhintergrund löschen (mit hellgrauer Farbe) }
SelectObject(DC,GetStockObject(White_Pen)); { Weißen "Stift" auswählen }
with Histogramm^ do
{ das Maximum des entsprechenden Histogramms laden, um den Maßstab der y-Achse
bestimmen zu können }
if HelligkeitRadio^.GetCheck = bf_Checked then Max := MaxHelligkeit
else if RotRadio^.GetCheck = bf_Checked then Max := MaxRot
else if GruenRadio^.GetCheck = bf_Checked then Max := MaxGruen
else if BlauRadio^.GetCheck = bf_Checked then Max := MaxBlau;
{ logarithmische Darstellung: statt der (linearen) Anzahl an Pixeln pro Histogrammeintrag wird der natürliche
Logarithmus von diesem verwendet -> kleinere Werte sind eher erkennbar }
if LogCheckbox^.GetCheck = bf_Checked then MassY := HistoH/ln(Max)
else MassY := HistoH/Max;
for x := 0 to HistoW-1 do begin { HistoW muß 256 sein - so werden
alle Intensitätsstufen von 0 bis 255 durch eine Line dargestellt }
MoveTo(DC,x+HistoX,HistoY+HistoH); { Linienursprungspunkt setzen }
with Histogramm^ do
if HelligkeitRadio^.GetCheck = bf_Checked then y := Helligkeit[x]
else if RotRadio^.GetCheck = bf_Checked then y := Rot[x]
else if GruenRadio^.GetCheck = bf_Checked then y := Gruen[x]
else if BlauRadio^.GetCheck = bf_Checked then y := Blau[x];
if LogCheckbox^.GetCheck = bf_Checked then y := Round(ln(y+1)*MassY)
{ ev. logarithmisch skalieren }
else y := Round(y*MassY); { ansonsten linearen Maßstab verwenden }
LineTo(DC,x+HistoX,HistoY+HistoH-y); { Linie zeichnen }
end;
ReleaseDC(HWindow,DC);
end;
procedure THistoDlg.HelligkeitRadioSelected(var Msg: TMessage);
begin
ZeichneHistogramm;
end;
procedure THistoDlg.RotRadioSelected(var Msg: TMessage);
begin
ZeichneHistogramm;
end;
procedure THistoDlg.GruenRadioSelected(var Msg: TMessage);
begin
ZeichneHistogramm;
end;
procedure THistoDlg.BlauRadioSelected(var Msg: TMessage);
begin
ZeichneHistogramm;
end;
procedure THistoDlg.LogCheckboxSelected(var Msg: TMessage);
begin
ZeichneHistogramm;
end;
var app: TApp;
begin
App.Init('FBA');
App.Run;
App.Done;
end.