home *** CD-ROM | disk | FTP | other *** search
- {*****************************************************************************
- Component : LsPicEditorMainD5.pas is a part of the LsPictureEditor
- (a Picture and Bitmap property editor for Delphi).
- Refrring to LsPictureEditor.txt for more infomation.
-
- Version : 2.400 for Delphi versions 3, 4, 5 & 6.
- (Last Modified September 2001)
-
- Author : Leo D. Shih e-mail: <ldshih@ecn.ab.ca>
-
- Copyright : (C)1998-2001 by Leo D. Shih, all rights reserved.
-
- DISCLAIMER : Current version of TLsPictureEditor (Software) is distributed
- as freeware, without warranties of any kind. either expressed
- or implied. In no event shall the author be liable for any
- problems or damages that may result from the use of this
- software.
-
- *****************************************************************************}
-
- {$IFNDEF VER90} //If not D2
- {$DEFINE D3_OR_hIGHER}
- {$IFNDEF VER100} //If not D3
- {$DEFINE D4_OR_HIGHER}
- {$IFNDEF VER120} //If not D4
- {DEFINE D5_OR_HIGHER}
- {$IFNDEF VER130} //If not D5
- {$DEFINE D6_OR_HIGHER}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF}
-
- unit LsPicEditorMainD6;
-
- interface
-
- uses
- Windows, Classes, Graphics, Forms, Controls, FileCtrl, StdCtrls,
- ExtCtrls, Buttons, Dialogs, Menus, Clipbrd, ComCtrls, SysUtils,
- IniFiles, Spin, ShellAPI, ShlObj
- {$IFDEF D4_OR_HIGHER},
- ImgList, ToolWin
- {$ENDIF};
-
-
- type
- TPEMainForm = class(TForm)
- SaveDialog1: TSaveDialog;
- PopupMenu1: TPopupMenu;
- NumGlyph1: TMenuItem;
- N1: TMenuItem;
- CopyImage1: TMenuItem;
- SaveImage1: TMenuItem;
- LbxBookMark: TListBox;
- StatusBar1: TStatusBar;
- PageControl1: TPageControl;
- TabSheet1: TTabSheet;
- TabSheet2: TTabSheet;
- TabSheet3: TTabSheet;
- TabSheet4: TTabSheet;
- StretchCheck: TCheckBox;
- Image1: TImage;
- Image2: TImage;
- Image3: TImage;
- Image4: TImage;
- Panel1: TPanel;
- Panel2: TPanel;
- Panel3: TPanel;
- Panel4: TPanel;
- Panel5: TPanel;
- Panel6: TPanel;
- Panel7: TPanel;
- Panel8: TPanel;
- Panel9: TPanel;
- Panel10: TPanel;
- SpeedButton1: TSpeedButton;
- SpeedButton2: TSpeedButton;
- SpeedButton3: TSpeedButton;
- SpeedButton4: TSpeedButton;
- SpeedButton5: TSpeedButton;
- SpeedButton6: TSpeedButton;
- SpeedButton7: TSpeedButton;
- SpeedButton8: TSpeedButton;
- SpeedButton9: TSpeedButton;
- SpeedButton10: TSpeedButton;
- SpeedButton11: TSpeedButton;
- SpeedButton12: TSpeedButton;
- SpeedButton13: TSpeedButton;
- SpeedButton14: TSpeedButton;
- SpeedButton15: TSpeedButton;
- SpeedButton16: TSpeedButton;
- SpeedButton17: TSpeedButton;
- SpeedButton18: TSpeedButton;
- SpeedButton19: TSpeedButton;
- SpeedButton20: TSpeedButton;
- SpeedButton21: TSpeedButton;
- SpeedButton22: TSpeedButton;
- SpeedButton23: TSpeedButton;
- SpeedButton24: TSpeedButton;
- SpeedButton25: TSpeedButton;
- SpeedButton26: TSpeedButton;
- SpeedButton27: TSpeedButton;
- SpeedButton28: TSpeedButton;
- SpeedButton29: TSpeedButton;
- SpeedButton30: TSpeedButton;
- SpeedButton31: TSpeedButton;
- SpeedButton32: TSpeedButton;
- SpeedButton33: TSpeedButton;
- SpeedButton34: TSpeedButton;
- SpeedButton35: TSpeedButton;
- BitBtn1: TBitBtn;
- DisabledBtn: TBitBtn;
- NextPgBtn: TBitBtn;
- ViewBtn: TBitBtn;
- ConvertBtn: TBitBtn;
- PathCombo: TComboBox;
- FileView: TListView;
- Label1: TLabel;
- Label2: TLabel;
- Label3: TLabel;
- Label4: TLabel;
- Label10: TLabel;
- Label12: TLabel;
- Label13: TLabel;
- Label14: TLabel;
- Label15: TLabel;
- Label18: TLabel;
- Label19: TLabel;
- PrevPgBtn: TBitBtn;
- Label9: TLabel;
- CancelBtn2: TBitBtn;
- GroupBox1: TGroupBox;
- RBtn16C: TRadioButton;
- RBtn256C: TRadioButton;
- RBtnHiC: TRadioButton;
- SEdtHeight: TSpinEdit;
- SEdtWidth: TSpinEdit;
- Label5: TLabel;
- Label6: TLabel;
- PopupMenu2: TPopupMenu;
- OpenBookmark1: TMenuItem;
- AddBookmark1: TMenuItem;
- DeleteBookmark1: TMenuItem;
- ToolBar1: TToolBar;
- ImageList1: TImageList;
- ToolButton1: TToolButton;
- ToolButton2: TToolButton;
- ToolButton3: TToolButton;
- ToolButton4: TToolButton;
- ToolButton5: TToolButton;
- ToolButton6: TToolButton;
- ToolButton8: TToolButton;
- ToolButton9: TToolButton;
- ImageList2: TImageList;
-
- procedure ViewBtnClick(Sender: TObject);
- procedure ViewAsGlyph(const FileExt: string);
- procedure StretchCheckClick(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure SaveBtnClick(Sender: TObject);
- procedure SpeedButtonMouseDown(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- procedure NextPgBtnClick(Sender: TObject);
- procedure DisabledBtnClick(Sender: TObject);
- procedure OKBtnClick(Sender: TObject);
- procedure CopyImageBtnClick(Sender: TObject);
- procedure ClearBtnClick(Sender: TObject);
- procedure CancelBtnClick(Sender: TObject);
- procedure PageControl1Change(Sender: TObject);
- procedure DisplayHint(Sender: TObject);
- procedure FormActivate(Sender: TObject);
- procedure BookMkBtnClick(Sender: TObject);
- procedure AddBookMkBtnClick(Sender: TObject);
- procedure DelBookMkBtnClick(Sender: TObject);
- procedure LbxBookMarkDblClick(Sender: TObject);
- procedure ConvertBtnClick(Sender: TObject);
- procedure LbxBookMarkDragOver(Sender, Source: TObject; X, Y: Integer;
- State: TDragState; var Accept: Boolean);
- procedure LbxBookMarkDragDrop(Sender, Source: TObject; X, Y: Integer);
- procedure LbxBookMarkMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
-
- procedure CreateImages;
- procedure PathComboUpdate(cPath: TFileName); //2.0
- procedure PathComboChange(Sender: TObject); //2.0
- procedure PathComboDrawItem(Control: TWinControl; Index: Integer;
- Rect: TRect; State: TOwnerDrawState); //2.0
- procedure PathComboClick(Sender: TObject); //2.0
- procedure FileViewBuildList(cDir: string); //2.0
- procedure FileViewCompare(Sender: TObject; Item1, Item2: TListItem;
- Data: Integer; var Compare: Integer); //2.0
- procedure FileViewClick(Sender: TObject); //2.0
- procedure FileViewDblClick(Sender: TObject); //2.0
- procedure FileViewChange(Sender: TObject; Item: TListItem;
- Change: TItemChange); //2.0
- procedure LoadBookMarks;
- procedure UpdateBookMarks;
- procedure AddBookMark(NewDir: string);
- procedure LoadGlyphs; //2.0
- procedure ClearGlyphs;
- procedure DrawGlyphs; //2.0
- procedure ReleaseBtn;
- procedure PrevPgBtnClick(Sender: TObject);
- procedure CancelBtn2Click(Sender: TObject);
- procedure RBtnClick(Sender: TObject);
- procedure ResetTabSheet3;
-
- private
- { Private declarations }
- DefaultDir: string;
- Icon1: TIcon;
- IniFile: TIniFile;
- LastDirIndex: integer;
- sSbName: string;
- Title: string;
- GlyphList: TStringList; //2.0
- GlyphIdx: integer; //2.0
- MaxIdx: integer; //2.0
- EmptyBtn: integer; //2.0
- sImages: TImageList; //2.0
- // mySImgList: TImageList; //2.1
- // SGoUpBmp: TBitmap; //2.1
- // SGoUpIdx: integer; //2.1
- SelectedPath: TFileName; //2.0
- SelectedFile: TFileName; //2.0
- Drives: set of 0..25; //2.0
- SelPath: TFileName; //2.2
- end;
-
- var
- PEMainForm: TPEMainForm;
-
- implementation
-
- {$R *.DFM}
-
- uses LsPicEditorViewD6;
-
-
- { ================== Global Functions/Procedures ================== }
-
- function NumPos(a: Char; b: string; c: integer): integer;
- var
- i, az: integer;
- begin
- Result := MaxInt;
- if Length(b) > 0 then
- begin
- az := 0;
- for i := 1 to Length(b) do
- if b[i] = a then
- begin
- inc(az);
- if az = c then
- begin
- Result := i;
- exit;
- end;
- end;
- end;
- end; //NumPos
-
- function GetCount(a: Char; b: string): integer;
- var
- i: integer;
- begin
- Result := 0;
- if Length(b) > 0 then
- for i := 1 to Length(b) do
- if b[i] = a then
- inc(Result);
- end; //GetCount
-
- function AddSlash(Path: string): string;
- begin
- if Path = '' then exit;
- if Path[Length(Path)] <> '\' then
- Result := Path + '\'
- else
- Result := Path;
- end; //AddSlash
-
- function DelSlash(Path: string): string;
- begin
- Result := Path;
- if Path <> '' then
- if Path[Length(Path)] = '\' then
- Delete(Result, Length(Path), 1);
- end; //DelSlash
-
- // Display applications Hints in StatusBar1
- procedure TPEMainForm.DisplayHint(Sender: TObject);
- begin
- StatusBar1.SimpleText := GetLongHint(Application.Hint);
- end; //DisplayHint
-
- procedure TPEMainForm.FormCreate(Sender: TObject);
- var
- WinDir: string;
- begin
- with LbxBookMark do begin
- Left := 2;
- Top := 2;
- Height := 120;
- Width := 460; //334; //2.1
- Visible := False;
- end;
- Panel4.Height := 36;
- Panel4.Width := 36;
- Panel8.Height := 36;
- Panel8.Width := 36;
- Icon1 := TIcon.Create;
- Application.OnHint := DisplayHint;
- Title := 'Property Editor (Bitmap & Picture)';
- Integer(Drives) := GetLogicalDrives;
- CreateImages;
- DefaultDir := GetCurrentDir;
- SetLength(WinDir, MAX_PATH); //2.3>>
- SetLength(WinDir, GetWindowsDirectory(PChar(WinDir), MAX_PATH));
- WinDir := Addslash(WinDir);
- if FileExists(WinDir + 'LsPEPicture.ini') then
- begin
- LoadBookMarks;
- if LbxBookMark.Items[LastDirIndex] <> '' then
- SelectedPath := LbxBookMark.Items[LastDirIndex];
- end
- else begin
- MessageDlg('ERROR - File LsPEPicture.ini not found' + #13 +
- 'hence BookMards will not work' , mtERROR, [mbOK], 0);
- SelectedPath := DefaultDir;
- end; //2.3
- PathComboUpdate(SelectedPath); //2.0
- FileViewBuildList(SelectedPath); //2.0
- end; //FormCreate
-
- procedure TPEMainForm.FormActivate(Sender: TObject);
- begin
- PageControl1.ActivePage := TabSheet1;
- end; //FormActivate
-
- procedure TPEMainForm.FormDestroy(Sender: TObject);
- begin
- sImages.Free;
- // SGoupBmp.Free;
- GlyphList.Free;
- ChDir(DefaultDir);
- end; //FormDestroy
-
- // If it is a Bitmap, Load it to Image2 and BitBtn1 as Glyph
- procedure TPEMainForm.ViewAsGlyph(const FileExt: string);
- begin
- if (PageControl1.ActivePage = TabSheet2) and (FileExt = '.BMP') then
- begin
- Image2.Picture := Image1.Picture;
- BitBtn1.Glyph := Image1.Picture.Bitmap;
- end;
- end; //ViewAsGlyph
-
- // To view the picture at its fullsize
- procedure TPEMainForm.ViewBtnClick(Sender: TObject);
- begin
- if (Image1.Picture.Width < 620) and
- (Image1.Picture.Height < 440) then
- begin
- PEViewForm.Width := Image1.Picture.Width + 20;
- PEViewForm.Height := Image1.Picture.Height + 40;
- end
- else begin
- PEViewForm.Width := 640;
- PEViewForm.Height := 480;
- PEViewForm.HorzScrollBar.Range := Image1.Picture.Width;
- PEViewForm.VertScrollBar.Range := Image1.Picture.Height;
- end;
- PEViewForm.Caption := Label1.Caption;
- PEViewForm.VFrmImage1.Picture := Image1.Picture;
- if not PEViewForm.Visible then
- PEViewForm.Show
- else PEViewForm.Hide;
- end; //ViewBtnClick
-
- // Stretch the picture size to fit Image1 if StretchCheckBox Checked
- procedure TPEMainForm.StretchCheckClick(Sender: TObject);
- begin
- Image1.Stretch := StretchCheck.Checked;
- end; //StretchCheckClick
-
- // Save the selected Picture to a file
- procedure TPEMainForm.SaveBtnClick(Sender: TObject);
- begin
- if Image1.Picture.Bitmap.Empty then
- begin
- MessageDlg('No Image selected', mtError, [mbOK], 0);
- exit;
- end;
- if Label1.Caption <> '' then
- SaveDialog1.Filename := Label1.Caption;
- SaveDialog1.Title := 'Save selected picture to file';
- SaveDialog1.InitialDir := SelectedPath; //GetCurrentDir; //2.3
- SaveDialog1.Filter := 'All Files(*.*)|*.*'; //2.1
- SaveDialog1.DefaultExt := '.bmp';
- if SaveDialog1.Execute then
- begin
- Image1.Picture.SaveToFile(SaveDialog1.Filename);
- SelectedPath := ExtractFilePath(SaveDialog1.Filename); //2.3
- end else
- ModalResult := mrNone;
- end; //SaveBtnClick
-
-
- {========== Draw bitmaps in speedbuttons on TabSheet2 as glyphs ==========}
-
- // Load all bmp file names in the current directory into GlyphList;
- procedure TPEMainForm.LoadGlyphs; //2.0
- var
- SRec: TSearchRec;
- Rslt: word;
- CurPath: string;
- OldCur: TCursor;
- begin
- GlyphIdx := 0;
- MaxIdx := 0;
- GlyphList := TStringList.Create;
- GlyphList.Clear;
- OldCur := Screen.Cursor;
- Screen.Cursor := crHourGlass;
- CurPath := AddSlash(SelectedPath);
- FillChar(SRec, SizeOf(SRec), 0);
- try
- Rslt := FindFirst(CurPath + '*.bmp', faAnyFile, SRec);
- while Rslt = 0 do
- begin
- GlyphList.Add(CurPath + SRec.Name);
- MaxIdx := MaxIdx + 1;
- Rslt := FindNext(SRec);
- end;
- FindClose(Srec);
- finally
- Screen.Cursor := OldCur;
- end;
- DrawGlyphs;
- NextPgBtn.Enabled := True;
- end; //LoadGlyphs
-
- // Draw glyphs into Speedbuttons on TabSheet2
- procedure TPEMainForm.DrawGlyphs; //2.0
- var
- i, j: integer;
- begin
- i := 0;
- j := 0;
- while i < ComponentCount do
- begin
- if Components[i] is TSpeedButton then
- with Components[i] as TSpeedButton do
- begin
- if GlyphIdx < (MaxIdx - 1) then
- begin
- Glyph.LoadFromFile(GlyphList.Strings[GlyphIdx]);
- NumGlyphs := Glyph.width div 16;
- Hint := ExtractFileName(GlyphList.Strings[GlyphIdx]); //tsRec.Name;
- Visible := True;
- Down := False;
- inc(GlyphIdx);
- inc(j);
- end
- else
- Visible := False;
- end;
- inc(i);
- end;
- EmptyBtn := 35 - j;
- end; //DrawGlyphs
-
- // Clear all Glyphs in SpeedButtons on TabSheet2
- procedure TPEMainForm.ClearGlyphs;
- var
- i: integer;
- begin
- i := 0;
- while i < ComponentCount do
- begin
- if Components[i] is TSpeedButton then
- begin
- DeleteObject(TSpeedButton(Components[i]).Glyph.ReleaseHandle);
- TSpeedButton(Components[i]).Glyph := nil;
- end;
- inc(i);
- end;
- end; //ClearGlyphs
-
- // Release all SpeedButtons on TabSheet2
- procedure TPEMainForm.ReleaseBtn;
- var
- i: integer;
- begin
- i := 0;
- while i < ComponentCount do
- begin
- if Components[i] is TSpeedButton then
- begin
- TSpeedButton(Components[i]).Down := False;
- end;
- inc(i);
- end;
- end; //ReleaseBtn
-
- // MouseDownEvent - LEFT-Button to select Glyph
- // RIGHT-Button to activate PopupMenu1
- procedure TPEMainForm.SpeedButtonMouseDown(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- var
- PtPos: TPoint;
- SelPict: TBitmap;
- SelFile: string;
- i: integer;
- begin
- SelFile := '';
- PtPos := Point(X, Y);
- PtPos := TSpeedButton(Sender).ClientToScreen(PtPos);
- sSBName := TSpeedButton(Sender).Name;
- if Button = mbLeft then
- begin
- SelPict := TSpeedButton(Sender).Glyph;
- SelFile := TSpeedButton(Sender).Hint;
-
- with FileView do
- begin
- FileView.SetFocus;
- FileView.Selected := nil; //2.2
- for i := 0 to (Items.Count - 1) do
- begin
- if (Items[i].Caption = SelFile) then
- begin
- Items[i].Selected := True;
- SelectedFile := Items[i].SubItems[0];
- Break;
- end;
- end;
- end;
-
- Image1.Picture.Graphic := SelPict;
- Image2.Picture.Graphic := SelPict;
- Label1.Caption := SelFile;
- Label3.Caption := Format('(%d x %d)',
- [Image1.Picture.Width, Image1.Picture.Height]);
- Caption := Title + ' - ' + SelFile;
- ViewAsGlyph('.BMP');
- end
- else if Button = mbRight then
- begin
- NumGlyph1.Caption := 'Num Glyphs = ' +
- IntToStr(TSpeedButton(Sender).NumGlyphs);
- PopupMenu1.Popup(PtPos.x + 10, PtPos.y + 6);
- end;
- end; //SpeedButtonMouseDown
-
- // Display next page of Glyphs
- procedure TPEMainForm.NextPgBtnClick(Sender: TObject);
- begin
- PrevPgBtn.Enabled := True;
- Image1.Picture.graphic := nil;
- Label1.Caption := '';
- Label3.Caption := '';
- Caption := Title;
- BitBtn1.Enabled := True;
- BitBtn1.Glyph := nil;
- Image2.Picture := nil;
- DisabledBtn.Tag := 0;
- DrawGlyphs;
- if GlyphIdx >= (MaxIdx - 1) then //2.0
- begin
- NextPgBtn.Enabled := False;
- Exit;
- end;
- end; //NextPgBtnClick
-
- // Display prior page of Glyphs
- procedure TPEMainForm.PrevPgBtnClick(Sender: TObject); //2.0
- begin
- NextPgBtn.Enabled := True;
- Image1.Picture.graphic := nil;
- Label1.Caption := '';
- Label3.Caption := '';
- Caption := Title;
- BitBtn1.Enabled := True;
- BitBtn1.Glyph := nil;
- Image2.Picture := nil;
- DisabledBtn.Tag := 0;
- if EmptyBtn > 0 then
- GlyphIdx := GlyphIdx - 70 + EmptyBtn
- else
- GlyphIdx := GlyphIdx - 70;
- if GlyphIdx <= 0 then
- begin
- GlyphIdx := 0;
- PrevPgBtn.Enabled := False;
- end;
- DrawGlyphs;
- end; //PrevPgBtnClick
-
- // Enable or Disable Glyphs in SpeedButtons.
- procedure TPEMainForm.DisabledBtnClick(Sender: TObject);
- var
- i: integer;
- begin
- with DisabledBtn do
- begin
- if Tag = 0 then
- begin
- Font.Color := clBlue;
- Caption := 'Enable';
- Hint := '| Enable Glyphs in SpeedButtons';
- Tag := 1;
- end
- else begin
- Font.Color := clRed;
- Caption := 'Disable';
- Hint := '| Disable Glyphs in SpeedButtons';
- Tag := 0;
- end;
- end;
- i := 0;
- while i < ComponentCount do
- begin
- if Components[i] is TSpeedButton then
- TSpeedButton(Components[i]).Enabled := (DisabledBtn.Tag = 0);
- inc(i);
- end;
- BitBtn1.Enabled := (DisabledBtn.Tag = 0);
- end; //DisabledBtnClick
-
- // Copy the selected Bitmap/Glyph to Clipboard
- procedure TPEMainForm.CopyImageBtnClick(Sender: TObject);
- begin
- if Image1.Picture.Bitmap.Empty then
- begin
- MessageDlg('No Image selected', mtError, [mbOK], 0);
- exit;
- end
- else if (UpperCase(ExtractFileExt(Label1.Caption)) = '.ICO') then
- begin
- MessageDlg('ClipBoard does not support Icons', mtInformation, [mbOK], 0);
- exit;
- end else
- ClipBoard.Assign(Image1.Picture.Graphic);
- end; //CopyImageBtnClick
-
- // Clear the displayed Bitmaps and/or Glyphs
- procedure TPEMainForm.ClearBtnClick(Sender: TObject);
- begin
- Image1.Picture := nil;
- Image2.Picture := nil;
- Image3.Picture := nil;
- Image4.Picture := nil;
- BitBtn1.Glyph := nil;
- Label1.Caption := '';
- Label3.Caption := '';
- Caption := Title;
- ReleaseBtn;
- end; //ClearBtnClick
-
- // Select the Bitmap as Glyph, and write current BookMark to IniFile
- procedure TPEMainForm.OKBtnClick(Sender: TObject);
- begin
- IniFile := TIniFile.Create('LsPEPicture.ini');
- with IniFile do
- try
- WriteInteger('General', 'LastDirIndex', LbxBookMark.ItemIndex);
- finally
- IniFile.Free;
- end; { finally }
- ChDir(DefaultDir);
- ModalResult := mrOK;
- end; //OKBtnClick
-
- // Cancel current operation
-
- procedure TPEMainForm.CancelBtnClick(Sender: TObject);
- begin
- ChDir(DefaultDir);
- ModalResult := mrCancel;
- end; //CancelBtnClick
-
-
- // Draw Glyphs in SpeedButtons when change to TabSheet2
- procedure TPEMainForm.PageControl1Change(Sender: TObject);
- begin
- if PageControl1.ActivePage = TabSheet2 then
- begin
- ViewAsGlyph('.BMP');
- LoadGlyphs;
- end
- else if PageControl1.ActivePage = TabSheet3 then
- begin
- ResetTabSheet3; //2.1
- RBtn256C.Checked := True; //2.1
- end
- else begin
- DeleteObject(BitBtn1.Glyph.ReleaseHandle);
- BitBtn1.Glyph := nil;
- ClearGlyphs;
- end; { else }
- end; //PageControl1Change
-
- // Open or Close BookMark List (LbxBookMark)
- procedure TPEMainForm.BookMkBtnClick(Sender: TObject);
- begin
- if not LbxBookMark.Visible then
- begin
- LbxBookMark.Visible := True;
- OpenBookMark1.Caption := 'Close Bookmarks'; //2.1
- end else
- begin
- LbxBookMark.Visible := False;
- OpenBookMark1.Caption := 'Open Bookmarks'; //2.1
- end;
- end; //BookMkBtnClick
-
- { ========================= BookMarks ============================= }
-
- // Load BookMarks from IniFile (LsPEPicture.ini) to BookMark List(LbxBookMark)
- procedure TPEMainForm.LoadBookMarks;
- var
- i,
- BookMarksCount: Integer;
- begin
- IniFile := TIniFile.Create('LsPEPicture.ini');
- with IniFile do
- try
- LbxBookMark.Items.Clear;
- LbxBookMark.ItemIndex := 0;
- BookMarksCount := ReadInteger('General', 'BookMarksCount', -1);
- if BookMarksCount = -1 then //2.3>>
- begin
- MessageDlg('ERROR - LsPEPicture.ini is empty or' + #13 +
- ' not in Windows directory', mtError,
- [mbOK], 0);
- exit;
- end; //2.3<<
- for i := 1 to BookMarksCount do
- begin
- LbxBookMark.ItemIndex := i - 1;
- LbxBookMark.Items.Add(ReadString('Path', 'Directory' +
- IntToStr(i), ''));
- end;
- LastDirIndex := ReadInteger('General', 'LastDirIndex', -1); //2.3
- if (LastDirIndex = -1) and
- (ReadString('Path', 'Directory1', '') <> '') then
- LastDirIndex := 0; //2.3
- // LbxBookMark.ItemIndex := LastDirIndex;
- finally
- Free;
- end;
- LbxBookMark.ItemIndex := LastDirIndex;
- end; //LoadBookMarks
-
- // Add current DirectoryListBox's directory to BookMark List
- procedure TPEMainForm.AddBookMkBtnClick(Sender: TObject);
- var
- CurDir: string;
- begin
- if SelectedPath = '' then //2.0
- begin
- MessageDlg('No Directory selected', mtError, [mbOK], 0);
- exit;
- end;
- CurDir := AddSlash(SelectedPath); //2.0
- if MessageDlg('Add the currently selected directory' + #13 +
- ' "' + UpperCase(CurDir) + '"' + #13 +
- 'to the BookMarks List?' + #13, mtConfirmation,
- [mbYes, mbNo], 0) = mrNo then
- exit;
- AddBookMark(CurDir);
- end; //AddBookMkBtnClick
-
- // Add a Directory(NewDir) to BookMark List
- procedure TPEMainForm.AddBookMark(NewDir: string);
- begin
- NewDir := LowerCase(NewDir);
- LbxBookMark.Items.Add(NewDir);
- LbxBookMark.ItemIndex := Pred(LbxBookMark.Items.Count);
- IniFile := TIniFile.Create('LsPEPicture.ini');
- with IniFile do
- try
- WriteInteger('General', 'BookMarksCount', LbxBookMark.Items.Count);
- WriteString('Path', 'Directory' + IntToStr(LbxBookMark.Items.Count),
- NewDir);
- finally
- Free;
- end;
- end; //AddBookMark
-
- // Delete selected BookMark from the BookMarks List
- procedure TPEMainForm.DelBookMkBtnClick(Sender: TObject);
- var
- OldIndex: integer;
- begin
- if (LbxBookMark.Items.Count = 0) or (LbxBookMark.ItemIndex = -1) or
- (LbxBookMark.Visible = False) then
- begin
- MessageDlg('No Bookmark selected', mtError, [mbOK], 0);
- exit;
- end;
- OldIndex := LbxBookMark.ItemIndex;
- if MessageDlg('Are you sure you want to delete' + #13 + ' "' +
- UpperCase(LbxBookMark.Items[OldIndex]) +
- '"' + #13 + 'from the BookMarks List ?', mtConfirmation,
- [mbYes, mbNo], 0) = mrYes then
- try
- LbxBookMark.Items.Delete(OldIndex);
- LbxBookMark.ItemIndex := 0;
- UpdateBookMarks;
- finally
- LbxBookMark.Visible := False;
- LoadBookMarks;
- end;
- end; //DelBookMkBtnClick
-
- // Select a BookMark as DirectoryListBox1's Directory
- procedure TPEMainForm.LbxBookMarkDblClick(Sender: TObject);
- var
- SelDir: string;
- begin
- SelDir := LbxBookMark.Items[LbxBookMark.ItemIndex];
- if DirectoryExists(SelDir) then
- begin
- SelectedPath := SelDir; //2.0
- PathComboUpdate(SelDir); //2.0
- FileViewBuildList(SelDir); //2.0
- PageControl1.ActivePage := TabSheet1; //2.0
- BookMkBtnClick(Sender); //2.3
- end else
- MessageDlg('Selected Directory does not exist', mtInformation, [mbOK], 0);
- LbxBookMark.Visible := False;
- end; //LbxBookMarkDblClick
-
- { ========== Drag-n-Drop BookMarks in the BookMarks List ========== }
-
- procedure TPEMainForm.LbxBookMarkDragOver(Sender, Source: TObject; X,
- Y: Integer; State: TDragState; var Accept: Boolean);
- var
- DropPos: Integer;
- begin
- if Source = LbxBookMark then
- begin
- DropPos := LbxBookMark.ItemAtPos(Point(X, Y), False);
- Accept := (DropPos > -1) and (DropPos < LbxBookMark.Items.Count);
- end
- else Accept := False;
- end; //LbxBookMarkDragOver
-
- procedure TPEMainForm.LbxBookMarkDragDrop(Sender, Source: TObject; X,
- Y: Integer);
- var
- OldPos: Integer;
- NewPos: Integer;
- begin
- if Source = LbxBookMark then
- begin
- OldPos := LbxBookMark.ItemIndex;
- NewPos := LbxBookMark.ItemAtPos(Point(X, Y), False);
- if (NewPos > -1) and (NewPos <> OldPos) then
- LbxBookMark.Items.Move(OldPos, NewPos);
- UpdateBookMarks;
- LbxBookMark.ItemIndex := NewPos;
- end;
- end; //LbxBookMarkDragDrop
-
- procedure TPEMainForm.LbxBookMarkMouseDown(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- var
- DragItem: Integer;
- begin
- if Button = mbLeft then
- begin
- DragItem := LbxBookMark.ItemAtPos(Point(X, Y), False);
- if (DragItem > -1) and (DragItem < LbxBookMark.Items.Count) then
- LbxBookMark.BeginDrag(False);
- end
- else if Button = mbRight then
- LbxBookMark.Visible := False;
- end; //LbxBookMarkMouseDown
-
- // Update IniFile (LsPEPicture.ini) after changing or deleting BookMarks
- procedure TPEMainForm.UpdateBookMarks;
- var
- i: integer;
- begin
- IniFile := TIniFile.Create('LsPEPicture.ini');
- with IniFile do
- try
- WriteInteger('General', 'BookMarksCount', LbxBookMark.Items.Count);
- EraseSection('Path');
- LbxBookMark.ItemIndex := 0;
- for i := 1 to LbxBookMark.Items.Count do begin
- LbxBookMark.ItemIndex := i - 1;
- WriteString('Path', 'Directory' + IntToStr(i),
- LowerCase(LbxBookMark.Items[Pred(i)]));
- end; // for
- finally
- Free;
- end;
- end; //UpdateBookMarks
-
-
- { ==================== Convert Icons to Bitmaps =================== }
-
- procedure TPEMainForm.ConvertBtnClick(Sender: TObject);
- var
- Rect1: TRect;
- Bmp1,
- Bmp2: TBitmap;
- const
- FExt = '.bmp';
- begin
- Bmp1 := TBitmap.Create;
- Bmp2 := TBitmap.Create;
- Image4.Picture := nil;
- SEdtWidth.Update;
- SEdtHeight.Update;
- if SEdtWidth.Value > 32 then
- Panel8.Width := SEdtWidth.Value + 4;
- if SEdtHeight.Value > 32 then
- Panel8.Height := SEdtHeight.Value + 4;
- if Icon1.Width > 32 then
- Panel4.Width := Icon1.Width + 4;
- if Icon1.Height > 32 then
- Panel4.Height := Icon1.Height + 4;
- with Rect1 do
- begin
- Top := 0;
- Left := 0;
- Right := SEdtWidth.Value;
- Bottom := SEdtHeight.Value;
- end;
-
- if Image3.Picture <> nil then
- try
- with Image3.Picture do
- begin
- Bmp1.Height := Icon.Height;
- Bmp1.Width := Icon.Width;
- Bmp1.Canvas.Draw(0, 0, Icon);
- end;
-
- if RBtn16C.Checked then
- Bmp2.PixelFormat := pf4bit
- else if RBtn256C.Checked then
- Bmp2.PixelFormat := pf8bit
- else if RBtnHiC.Checked then
- Bmp2.PixelFormat := pf24bit;
-
- with Bmp2 do
- begin
- Width := SEdtWidth.Value;
- Height := SEdtHeight.Value;
- Canvas.StretchDraw(Rect1, Bmp1);
- end;
- Image4.Picture.Bitmap.Assign(Bmp2);
- Image1.Picture.Bitmap.Assign(Bmp2);
-
- Label1.Caption :=
- ChangeFileExt(ExtractFileName(FileView.Selected.SubItems[0]), FExt);
- Caption := Title + ' - ' + Label1.Caption;
- Label3.Caption := Format('(%d x %d)', [Image1.Picture.Width,
- Image1.Picture.Height]);
- ConvertBtn.Enabled := False;
- finally
- Bmp1.Free;
- Bmp2.Free;
- end;
- end; //ConvertBtnClick
-
- procedure TPEMainForm.CancelBtn2Click(Sender: TObject);
- begin
- Image3.Picture := nil;
- Image4.Picture := nil;
- ResetTabSheet3; //2.1
- RBtn256C.Checked := True; //2.1
- end; //CancelBtn2Click
-
- procedure TPEMainForm.ResetTabSheet3; //2.1 >>
- begin
- Image3.Picture := nil;
- Panel4.Height := 36;
- Panel4.Width := 36;
- Panel8.Height := 36;
- Panel8.Width := 36;
- SEdtHeight.Value := 32;
- SEdtWidth.Value := 32;
- end; //ResetTabSheet3 //2.1 <<
-
- procedure TPEMainForm.RBtnClick(Sender: TObject); //2.1
- begin
- Image3.Picture := nil;
- end; //RBtnClick //2.1
-
-
- { ================== PathCombo and FileView ======================= }
-
-
- procedure TPEMainForm.CreateImages; //2.0
- var
- SysIL: UInt;
- SFI: TSHFileInfo;
- begin
- sImages := TImageList.Create(self);
- SysIL := SHGetFileInfo('', 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX
- or SHGFI_SMALLICON);
- if SysIL <> 0 then
- begin
- sImages.Handle := SysIL;
- sImages.ShareImages := True;
- end;
- FileView.SmallImages := sImages;
- {**
- mySImgList := TImageList.Create(Self);
- mySImgList.Assign(sImages);
- SGoupBmp := TBitmap.Create;
- SGoupBmp.LoadFromResourceName(hInstance, 'Parent');
- SGoupIdx := mySImgList.Add(SGoupBmp, nil);
- mySImgList.ShareImages := False;
- FileView.SmallImages := mySImgList;
- **}
- end; //CreateImages
-
- procedure TPEMainForm.PathComboUpdate(cPath: TFileName); //2.0
- var
- Drv: byte;
- selDrv: byte;
- isDrive: boolean;
- i,
- cnt: integer;
- begin
- SelPath := AddSlash(cPath); //2.2
- with PEMainForm do
- begin
- PathCombo.items.beginupdate;
- PathCombo.items.clear;
- i := -1;
- isDrive := cPath = 'My Computer';
- selDrv := ord(upcase(cPath[1])) - ord('A');
- PathCombo.items.add('0:My Computer');
- for Drv := 0 to 25 do
- if Drv in drives then
- begin
- PathCombo.items.add('1:' + char(Drv + ord('A')) + ':\');
- if (not isDrive) and (Drv = selDrv) then
- begin
- for cnt := 1 to getcount('\', cPath) - 1 do
- PathCombo.items.add(IntToStr(cnt + 1) + ':'
- + copy(cPath, 1, numpos('\', cPath, cnt + 1)));
- i := PathCombo.items.count - 1;
- end;
- if isDrive then
- i := 0;
- end;
- // if i > -1 then //2.2
- // PathCombo.items[i] := 'T' + PathCombo.items[i]; //2.2
- // PathCombo.itemindex := -1; //2.2
- PathCombo.items.endupdate;
- PathCombo.itemindex := i;
- end;
- end; //PathComboUpdate
-
- procedure TPEMainForm.PathComboChange(Sender: TObject); //2.0
- var
- DirStr : string;
- begin
- if PathCombo.droppeddown then exit;
- if PathCombo.itemindex <= 0 then exit;
- if PathCombo.itemindex = 0 then exit;
- DirStr := PathCombo.items[PathCombo.itemindex];
- DirStr := copy(DirStr, pos(':', DirStr) + 1, MaxInt);
- if (DirStr <> 'My Computer') and (not DirectoryExists(DirStr)) then
- begin
- MessageDlg('" ' + DirStr + ' " is inaccessible !', mtInformation, [mbOK], 0);
- PathComboUpdate(SelPath); //SelectedPath); //2.2
- SelectedPath := SelPath; //2.2
- end
- else begin
- SelectedPath := DirStr; //2.0
- PathComboUpdate(SelectedPath);
- FileViewBuildList(SelectedPath);
- end;
- end; //PathComboChange
-
- procedure TPEMainForm.PathComboDrawItem(Control: TWinControl;
- Index: Integer; Rect: TRect; State: TOwnerDrawState); //2.0
- var
- DirName,
- DirStr: string;
- sfi: tshfileinfo;
- tab: integer;
- mode: integer;
- begin
- fillchar(sfi, sizeof(tshfileinfo), 0);
- with PathCombo, PathCombo.canvas do
- begin
- Canvas.Font.Name := 'MS Sans Serif';
- Canvas.Font.Size := 8;
- mode := SHGFI_ICON or SHGFI_SMALLICON or SHGFI_DISPLAYNAME;
- DirStr := items[index];
- // if DirStr[1] = 'T' then //2.2 >>
- // begin
- // DirStr := copy(DirStr, 2, maxint);
- // mode := mode or SHGFI_OPENICON;
- // end; //2.2 <<
- sImages.drawingstyle := dsTransparent;
- if odselected in state then
- sImages.drawingstyle := dsSelected;
- fillrect(rect);
- if DirStr = '0:My Computer' then
- begin
- sfi.szDisplayname := 'My Computer';
- sfi.iIcon := 15;
- end
- else
- SHGetFileInfo(pchar(copy(DirStr, pos(':', DirStr) + 1, maxint)), 0,
- sfi, sizeof(TSHFileInfo), mode);
- DirName := sfi.szDisplayName;
- tab := StrToInt(copy(DirStr, 1, pos(':', DirStr) - 1)) * 8;
-
- if not droppeddown then tab := 0;
-
- TextOut(Rect.Left + 20 + tab, Rect.Top + 2, DirName);
- sImages.draw(canvas, Rect.Left + 2 + tab, Rect.Top + 2, sfi.iIcon);
- sImages.drawingstyle := dsNormal;
- end;
- end; //PathComboDrawItem
-
- procedure TPEMainForm.PathComboClick(Sender: TObject); //2.0
- begin
- with PathCombo do
- begin
- if ItemIndex = -1 then exit;
- if (ItemIndex = 0) then
- PathComboUpdate(SelectedPath)
- else begin
- SelectedPath := Items[ItemIndex];
- FileViewBuildList(SelectedPath);
- end;
- end;
- end; //PathComboClick
-
- procedure TPEMainForm.FileViewBuildList(cDir: string); //2.0
- var
- CurDir,
- FName,
- FileName,
- FileOrDir: string;
- sfi: TSHFileInfo;
- hFindFile: THandle;
- Win32FD: TWin32FindData;
- OldCur: TCursor;
- begin
- OldCur := Screen.Cursor;
- CurDir := AddSlash(cDir);
- hFindFile := FindFirstFile(PChar(CurDir + '*.*'), Win32FD);
- if hFindFile <> INVALID_HANDLE_VALUE then
- try
- Screen.Cursor := crHourGlass;
- FileView.Items.BeginUpdate;
- FileView.Items.Clear;
- repeat
- with Win32FD do
- begin
- if (dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY > 0) then
- FileOrDir := 'dir'
- else
- FileOrDir := 'file';
-
- FName := StrPas(Win32FD.cFileName);
- FileName := CurDir + FName;
- if (FName = '.') then continue;
-
- SHGetFileInfo(PChar(FileName), 0, sfi, SizeOf(sfi),
- SHGFI_SYSICONINDEX or SHGFI_DISPLAYNAME);
-
- with FileView.Items.Add do
- begin
- if FName = '..' then
- Caption := ' ^Up 1 level'
- else
- Caption := FName;
- ImageIndex := sfi.iIcon;
- SubItems.Add(FileName);
- SubItems.Add(FileOrDir);
- end;
- end;
- until not FindNextFile(hFindFile, Win32FD);
- finally
- Windows.FindClose(hFindFile);
- FileView.Items.EndUpdate;
- Screen.Cursor := OldCur;
- end;
- end; //FileViewBuildList
-
- procedure TPEMainForm.FileViewCompare(Sender: TObject; Item1, Item2: TListItem;
- Data: Integer; var Compare: Integer); //2.0
- var
- Caption1,
- Caption2: string;
- result: integer;
- begin
- result := 0;
- if (Item1.SubItems[1] = 'dir') and (Item2.SubItems[1] <> 'dir') then
- Result := -1
- else if (Item1.SubItems[1] <> 'dir') and (Item2.SubItems[1] = 'dir') then
- Result := 1
- else
- begin
- Caption1 := AnsiUpperCase(Item1.Caption);
- Caption2 := AnsiUpperCase(Item2.Caption);
- if Caption1 > Caption2 then
- Result := 1
- else if Caption1 < Caption2 then
- Result := -1;
- end;
- Compare := Result;
- end; //FileViewCompare
-
- procedure TPEMainForm.FileViewDblClick(Sender: TObject); //2.0
- var
- CurDir,
- NewDir: TFileName;
- begin
- CurDir := '';
- NewDir := '';
- PageControl1.ActivePage := TabSheet1;
- with FileView do
- begin
- if (Selected <> nil) and (Selected.SubItems[1] = 'dir') then
- begin
- if Selected.Caption = ' ^Up 1 level' then
- begin
- CurDir := SelectedPath;
- CurDir := DelSlash(CurDir);
- NewDir := ExtractFilePath(CurDir);
- end
- else begin
- CurDir := Selected.SubItems[0];
- NewDir := AddSlash(CurDir);
- end;
- if NewDir <> '' then
- begin
- SelectedPath := NewDir;
- PathComboUpDate(SelectedPath);
- FileViewBuildList(SelectedPath);
- end
- end;
- end;
- end; //FileViewDblClick
-
- procedure TPEMainForm.FileViewClick(Sender: TObject); //2.0
- var
- FileExt: string[4];
- begin
- ClearBtnClick(Sender);
- PageControl1.ActivePage := TabSheet1;
- if FileView.Selected <> nil then //2.0
- SelectedFile := FileView.Selected.SubItems[0];
- FileExt := UpperCase(ExtractFileExt(SelectedFile));
-
- if (FileExt = '.BMP') or (FileExt = '.ICO') or
- (FileExt = '.WMF') then
- begin
- Image1.Picture.LoadFromFile(SelectedFile);
- Image2.Picture := Image1.Picture;
- Label1.Caption := ExtractFilename(SelectedFile);
- Caption := Title + ' - ' + Label1.Caption;
-
- if (FileExt = '.BMP') then
- begin
- PageControl1.ActivePage := TabSheet1;
- Label3.Caption := Format('(%d x %d)', [Image1.Picture.Width,
- Image1.Picture.Height]);
- ViewAsGlyph(FileExt);
- end;
-
- if FileExt = '.ICO' then
- begin
- PageControl1.ActivePage := TabSheet3;
- Icon1 := Image1.Picture.Icon;
- Image3.Picture.Icon := Icon1;
- Image4.Picture := nil;
- ConvertBtn.Enabled := True;
- end;
-
- if FileExt = '.WMF' then
- PageControl1.ActivePage := TabSheet1;
- end;
- ReleaseBtn;
- end; //FileViewClick
-
- procedure TPEMainForm.FileViewChange(Sender: TObject; Item: TListItem;
- Change: TItemChange); //2.0
- var
- CurPath: string;
- begin
- CurPath := AddSlash(SelectedPath);
- Image1.Picture.Graphic := nil;
- Image2.Picture.Graphic := nil;
- BitBtn1.Glyph := nil;
- Label1.Caption := '';
- Label3.Caption := '';
- Caption := Title;
- end; //FileViewChange
-
- end.
-
-